VBA Find Next Occurrence - excel

Question

Hey I'm currently writing a macro in VBA (which I'm quite new at). The macro looks at a spreadsheet and finds specific column headers. It then clears the contents of any cell containing a zero. This part of my code works exactly how I want, the only issue is that it does not hand multiple occurrences of the column header...so it finds the first header, clears the contents, and ignores the second occurrence. I have tried multiple avenues whether it be looping to find it or using the .FindNext function. Any help would be appreciated. Thank you! My code is posted below:
Sub DeleteRows2()
Application.ScreenUpdating = True
Dim lastrow As Long
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'~~>Start of First Instance
'~~>dim variables and set initial values
Dim delaymaxheader As Range
Set delaymaxheader = Worksheets(ActiveSheet.Name).Range("A4:Z4").Find(what:="DELAY Spec Max", LookAt:=xlWhole, MatchCase:=False)
Dim delaymaxcolumn As Range
Set delaymaxcolumn = Range(Cells(5, delaymaxheader.Column), Cells(lastrow, delaymaxheader.Column))
'Set delaymaxcolumn = Range(delaymaxheader.Offset(1, 0), delaymaxheader.End(xlDown))
'~~>dim variables and set initial values
Dim delayminheader As Range
Set delayminheader = Worksheets(ActiveSheet.Name).Range("A4:Z4").Find(what:="DELAY Spec Min", LookAt:=xlWhole, MatchCase:=False)
Dim delaymincolumn As Range
Set delaymincolumn = Range(Cells(5, delayminheader.Column), Cells(lastrow, delayminheader.Column))
'Set delaymincolumn = Range(delayminheader.Offset(1, 0), delayminheader.End(xlDown))
'~~>dim variables and set initial values
Dim phasemaxheader As Range
Set phasemaxheader = Worksheets(ActiveSheet.Name).Range("A4:Z4").Find(what:="PHASE Spec Max", LookAt:=xlWhole, MatchCase:=False)
Dim phasemaxcolumn As Range
Set phasemaxcolumn = Range(Cells(5, phasemaxheader.Column), Cells(lastrow, phasemaxheader.Column))
'Set phasemaxcolumn = Range(phasemaxheader.Offset(1, 0), phasemaxheader.End(xlDown))
'~~>dim variables and set initial values
Dim phaseminheader As Range
Set phaseminheader = Worksheets(ActiveSheet.Name).Range("A4:Z4").Find(what:="PHASE Spec Min", LookAt:=xlWhole, MatchCase:=False)
Dim phasemincolumn As Range
Set phasemincolumn = Range(Cells(5, phaseminheader.Column), Cells(lastrow, phaseminheader.Column))
'Set phasemincolumn = Range(phaseminheader.Offset(1, 0), phaseminheader.End(xlDown))
'~~>Loop to delete rows with zero
'~~>Dim delaycount(5 To lastrow) As Integer
For i = 5 To lastrow
If Cells(i, delaymaxheader.Column) = 0 Then
Cells(i, delaymaxheader.Column).ClearContents
End If
If Cells(i, delayminheader.Column) = 0 Then
Cells(i, delayminheader.Column).ClearContents
End If
If Cells(i, phasemaxheader.Column) = 0 Then
Cells(i, phasemaxheader.Column).ClearContents
End If
If Cells(i, phaseminheader.Column) = 0 Then
Cells(i, phaseminheader.Column).ClearContents
End If
Next i
End Sub

Answer 1

You need to use the FindNext method to keep going (https://msdn.microsoft.com/en-us/library/office/ff839746.aspx)
LastRow is only the last row of column A though - what happens if another column goes further?
Also Worksheets(ActiveSheet.Name).Range("A4:Z4") is the same as ActiveSheet.Range("A4:Z4").
Public Sub DeleteRows()
Dim colAllRanges As Collection
Dim colHeadings As Collection
'Declared as variants as they're used to step through the collection.
Dim vHeading As Variant
Dim vRange As Variant
Dim vCell As Variant
Dim rDelayMaxHeader As Range
Dim sFirstAddress As String
Dim lLastRow As Long
With ActiveSheet
lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Set colAllRanges = New Collection
Set colHeadings = New Collection
colHeadings.Add "DELAY Spec Max"
colHeadings.Add "DELAY Spec Min"
colHeadings.Add "PHASE Spec Max"
colHeadings.Add "PHASE Spec Min"
For Each vHeading In colHeadings
With ActiveSheet.Range("A4:Z4")
'Find the first instance of the heading we're looking for.
Set rDelayMaxHeader = .Find(What:=vHeading, LookIn:=xlValues, LookAt:=xlWhole)
If Not rDelayMaxHeader Is Nothing Then
sFirstAddress = rDelayMaxHeader.Address
Do
'Resize the range from heading to last row and add it to the collection.
colAllRanges.Add rDelayMaxHeader.Resize(lLastRow - rDelayMaxHeader.Row + 1, 1)
'Find the next occurrence.
Set rDelayMaxHeader = .FindNext(rDelayMaxHeader)
'Keep going until nothings found or we loop back to the first address again.
Loop While Not rDelayMaxHeader Is Nothing And rDelayMaxHeader.Address <> sFirstAddress
End If
End With
Next vHeading
'Now to go through each cell in the range we've added to the collection and check for 0's.
For Each vRange In colAllRanges
For Each vCell In vRange
If vCell = 0 Then
vCell.ClearContents
End If
Next vCell
Next vRange
End Sub
With the above method you can add extra columns if needed - just add another colHeadings.Add "My New Column Header" row in the code.