Right click the sheet's tab, View Code, and paste for the first code block. There is code after that that goes into a Module. I tend to code with Dim and use routines more modular than some because I am lazy and help many with similar needs.
For your 2nd item about filter, if you filter by XYZ then all rows in that column are hidden <> XYZ. Were you wanting a macro to do the autofilter? Normally, one would just do that manually but some like more control.
As I explained in your other thread, I coded this so that if you cut and paste back your A and C columns, it will hide/show the checkbox form controls as you wanted. From then on, a one cell change columns A or C below row 1 will trigger it again.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, c As Range, calc As Integer
Dim lr As Long, s As Shape, a, sa, pos As Long
Dim i As Long
On Error GoTo TheEnd
Set r = StripFirstRow(ActiveSheet.UsedRange)
Set r = Intersect(Union(Columns("A"), Columns("C")), Target)
If r Is Nothing Then Exit Sub
With Application
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With
'Make 2 arrays to hold shape names and topleftcell address
ReDim a(1 To Shapes.Count)
sa = a
For Each s In Shapes
i = i + 1
sa(i) = s.Name
a(i) = s.TopLeftCell.Address
Next s
'Iterate each cell change in the target range.
'Set shape in target row's column D to visible or not.
For Each c In r
lr = c.Row
pos = PosInArray(Cells(lr, "E").Address, a)
If c.Value = "" Then
If pos > 0 Then Shapes(sa(pos)).Visible = msoFalse
Else
If Cells(lr, "A").Value <> "" And Cells(lr, "C").Value <> "" And _
pos > 0 Then Shapes(sa(pos)).Visible = msoTrue
End If
Next c
TheEnd:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = calc
.CutCopyMode = False
End With
End Sub
Module code:
Code:
Function StripFirstRow(aRange As Range) As Range
Dim i As Long, j As Long, r As Range, z As Long, idx As Long
For i = 1 To aRange.Areas.Count
For j = 1 To aRange.Areas(i).Rows.Count
z = z + 1
If z = 1 Then GoTo NextJ
If r Is Nothing Then
Set r = aRange.Areas(i).Rows(j)
Else
Set r = Union(r, aRange.Areas(i).Rows(j))
End If
NextJ:
Next j
Next i
Set StripFirstRow = r
End Function
'If array is 0 based, 1 is returned if aValue matches anArray(0).
Function PosInArray(aValue, anArray)
Dim pos As Long
On Error Resume Next
pos = -1
pos = WorksheetFunction.Match(CStr(aValue), anArray, 0)
PosInArray = pos
End Function
