Search code examples
excelvba

Strikethrough Rows with specific values from 2 Columns


I have some code that is working, but not completely. This code is taking values that are input into a Form. From there it looks to see if those values are found in Columns B and D. If they are both present, then the entire row has a strikethrough applied.

My issue is that once it finds a match, it isnt able to find another match if the user launches the form again. It believe the FoundCell variable I have isnt resetting, it is holding the range from the intial run.

Of the 2 values being searched, the values in Column B can be repeated, but the value in Column D would be unique. So I think once it finds the first example of B & D both being present and then doing the strikethrough, it is incapable of finding another B & D because the find function already found an A.1. in column B.

Dim A1 As Integer
Dim sec1 As String

'''A.1.
If sec1x = True Then   '''This is a checkbox on the form
    sec1 = "A.1."      ''' this is the value in column B
    A1 = A1x.Text      ''' this is the value that is searched for in Column D
    Dim lrow As Long
    Dim rng As Range

    lrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row

    Dim findWS As Worksheet
    Dim findRng As Range
    Dim findStr As String
    Dim foundCell As Range
    Dim rowrng
    
    Set findWS = ActiveSheet
    Set findRng = findWS.Range("B3:B" & lrow)

    findStr = sec1
    
    Set foundCell = findRng.Find(what:=findStr, LookIn:=xlFormulas, MatchCase:=False, lookat:=xlWhole)
    Set rowrng = foundCell
        If foundCell.Offset(0, 2).Value = A1 Then
            rowrng.EntireRow.Font.Strikethrough = True
        End If
        MsgBox foundCell.Row '''This was a test, that once its done the foundcell row doesnt change
End If

Solution

  • Something like this should do it:

    Dim A1 As Long, sec1 As String
    Dim lrow As Long, rng As Range, ws As Worksheet, arr
    Dim findRng As Range, r As Long
    
    If sec1x = True Then   'This is a checkbox on the form
        
        sec1 = "A.1."        ' this is the value in column B
        A1 = CLng(A1x.TEXT)  ' this is the value that is searched for in Column D
        
        Set ws = ActiveSheet
        Set findRng = ws.Range("B3:D" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
        arr = findRng.Value 'read range data to array
        
        For r = 1 To UBound(arr, 1)    'loop over array rows
            If arr(r, 1) = sec1 Then   'check colB value
                If arr(r, 3) = A1 Then 'check colD value
                    With findRng.Rows(r).EntireRow
                        .Font.Strikethrough = True
                        .Columns("N").Value = "N/A"
                    End With
                End If
            End If
        Next r
    End If