Repeating an 'If' formula to last row

Question

I have this worksheet that I have an IF formula in VBA that searches V9:Z9 for like values (DIST8 and DIST6). The formula fills AO9 with a 1 or 0. This formula works for my purpose. I want to repeat this formula until the last row.

Dim DIST8 As String
Dim DIST6 As String
DIST8 = "DIST8"
      ' Select cell A9, *first line of data*.
      Range("A9").Select
      ' Set Do loop to stop when an empty cell is reached.
      Do Until IsEmpty(ActiveCell)
         ' Insert your code here
                If Worksheets("Sheet1").Range("v9") Like "*" & "DIST8" & "*" Or Worksheets("Sheet1").Range("w9") Like "*" & "DIST8" & "*" Or Worksheets("Sheet1").Range("x9") Like "*" & "DIST8" & "*" Or Worksheets("Sheet1").Range("y9") Like "*" & "DIST8" & "*" Or Worksheets("Sheet1").Range("z9") Like "*" & "DIST8" & "*" Or Worksheets("Sheet1").Range("v9") Like "*" & "DIST6" & "*" Or Worksheets("Sheet1").Range("w9") Like "*" & "DIST6" & "*" Or Worksheets("Sheet1").Range("x9") Like "*" & "DIST6" & "*" Or Worksheets("Sheet1").Range("y9") Like "*" & "DIST6" & "*" Or Worksheets("Sheet1").Range("z9") Like "*" & "DIST6" & "*" Then
                    Worksheets("Sheet1").Range("Ao9").Value = 1
                Else
                    Worksheets("Sheet1").Range("Ao9").Value = 0
                End If
         ' Step down 1 row from present location.
         ActiveCell.Offset(1, 0).Select
      Loop

Unfortunately the loop isn't working correctly, the sheet will scroll down to the last row but not filling the IF beyond the first row. I want to run the same IF formula but change the row number eg; v9 to v10, w9 to w10, etc.

What is the best way of achieving this?

Answer 1

To use your loop, you need to keep raising the row number in Range("v9"), Range("Ao9"), etc. or you will just be comparing and writing new values into the same cell(s).

    Dim DIST8 As String, DIST6 As String, r As Long, lr As Long

    DIST6 = "DIST6"  '<~~ don't forget DIST6 or the wildcards will make everything a 1.
    DIST8 = "DIST8"

    With Worksheets("Sheet1")
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        For r = 9 To lr
            If .Range("v" & r) Like "*" & DIST8 & "*" Or .Range("w" & r) Like "*" & DIST8 & "*" Or _
               .Range("x" & r) Like "*" & DIST8 & "*" Or .Range("y" & r) Like "*" & DIST8 & "*" Or _
               .Range("z" & r) Like "*" & DIST8 & "*" Or .Range("v" & r) Like "*" & DIST6 & "*" Or _
               .Range("w" & r) Like "*" & DIST6 & "*" Or .Range("x" & r) Like "*" & DIST6 & "*" Or _
               .Range("y" & r) Like "*" & DIST6 & "*" Or .Range("z" & r) Like "*" & DIST6 & "*" Then
                .Range("Ao" & r).Value = 1
            Else
                .Range("Ao" & r).Value = 0
            End If
        Next r

    End With

Loops such as you are using are fine for 25-500 records but they can be sped up by bulk loading a formula and then reverting to the values. If you are dealing with >5K records, the speed increase will be appreciable.

    Dim DIST8 As String, DIST6 As String, lr As Long

    DIST6 = "DIST6"  '<~~ don't forget DIST6 or the wildcards will make everything a 1.
    DIST8 = "DIST8"

    With Worksheets("Sheet1")
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        With .Range(.Cells(9, "AO"), .Cells(lr, "AO"))
            .Formula = "=SIGN(SUM(COUNTIF(V9:Z9, {""*" & DIST6 & "*"", ""*" & DIST8 & "*""})))"
            .Value = .Value
        End With
    End With

Note that the latter routine's COUNTIF function is not case sensitive while your original pattern matching is case sensitive by default. Put Option Compare Text at the top of your module sheet in the Declarations section if you want non-case-sensitive comparisons for the pattern matching.