1

I need to highlight cells: If already highlighted then find number in another cell and highlight that

Here is my very basic code.

It works but I have found if I have muliples of the same number it will still only highlight the first found. I need it to be able to tell that its already highlighted and move to the next and highlight that one.

Sub Find_FirstmanUALDar()
    Dim FindString8 As String
    Dim Rng8 As Range
    FindString8 = Sheets("DAR").Range("D12").Value
    If Trim(FindString1) <> "" Then
        With Sheets("GL").Range("AC:AC")
            Set Rng8 = .Find(What:=FindString8, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
             If Not Rng8 Is Nothing Then
                 Application.Goto Rng8, True
                 With Selection.Interior
                     .Pattern = xlSolid
                     .PatternColorIndex = xlAutomatic
                     .Color = 65535
                     .TintAndShade = 0
                     .PatternTintAndShade = 0
                 End With
             End If
        End With

I know its ugly but please help. Thanks

4

1 に答える 1

4 
Sub Tester()
    Dim rng As Range

    Set rng = FindAll(Sheets("GL").Range("AC:AC"), "test")

    If Not rng Is Nothing Then
        rng.Interior.Color = 65535
    End If

End Sub


Public Function FindAll(rng As Range, val As String) As Range
    Dim rv As Range, f As Range
    Dim addr As String

    Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.Count), _
        LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False)
    If Not f Is Nothing Then addr = f.Address()

    Do Until f Is Nothing
        If rv Is Nothing Then
            Set rv = f
        Else
            Set rv = Application.Union(rv, f)
        End If
        Set f = rng.FindNext(after:=f)
        If f.Address() = addr Then Exit Do
    Loop

    Set FindAll = rv
End Function
于 2012-08-23T21:54:09.760 に答える