CODEWITHSUNDEEP
vbaexcel
tombata
tombata

Reputation: 259

Find values in as sheet from a list in another sheet and color the whole row

I have values in sheet 1 in column I, which number can vary.

I want to find these values in Sheet 2 and to color the entire rows, where these values are in Sheet 2.

 Dim FindString As Range
 Dim Rng As Range

        FindString = Worksheets("Sheet1").Range("I2" &  _
        .Range("I" & .Rows.Count).End(xlUp).Row + 1).Value

        If Trim(FindString) <> "" Then
            With Sheets("Sheet2").Range("A1:AZ500")
                Set Rng = .Find(What:=FindString, _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                If Not Rng Is Nothing Then
                    'Application.Goto Rng, True
                Else

                End If
            End With
        End If

        With Rng.Interior
            .Pattern = xlSolid
            .Color = 255
        End With

Upvotes: 1

Views: 90

Answers (2)

R3uK
R3uK

Reputation: 14537

FindString was in fact an array, so I changed its declaration.

But you'll need to loop on that array to search for all values :
For i = LBound(FindString, 1) To UBound(FindString, 1)

And as you may not have this value only one time in the 2nd sheet, you'll need to use FindNext

Dim FindString() As Variant
Dim Rng As Range
Dim i As Long
Dim FirstAddress As String
Dim LastRow As Long

With Sheets("Sheet1")
    LastRow = .Range("J" & .Rows.Count).End(xlUp).Row
    If LastRow > 2 Then
        FindString = .Range("J2:J" & LastRow).Value
    Else
        ReDim FindString(1 To 1, 1 To 1)
        FindString(1,1) = .Range("J2").Value
    End If
End With 'Sheets("Sheet1")

For i = LBound(FindString, 1) To UBound(FindString, 1)
    If Trim(FindString(i, 1)) <> vbNullString Then
        With Sheets("Sheet2").Range("A1:AZ500")
            Set Rng = .Find(What:=FindString(i, 1), _
                            After:=.Cells(1, 1), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)


            If Not Rng Is Nothing Then
                With Rng
                    FirstAddress = .Address
                    Do
                        With .EntireRow.Interior
                            .Pattern = xlSolid
                            .Color = 255
                        End With
                        Set Rng = .FindNext(Rng)
                    'Look until you find again the first result
                    Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
                End With 'Rng
            End If
        End With 'Sheets("Sheet2").Range("A1:AZ500")
    Else
    End If
Next i

Upvotes: 1

user3598756
user3598756

Reputation: 29421

edited to add solution

you're dimming FindString As Range, but then using it as an array (FindString = someRange.Value)

you'd better off using AutoFilter()

I'm not sure if you are searching for FindString values among column A or among columns A:AZ of Sheet2 , so I post the code for both options

searching for FindString values among column A of Sheet2

Sub main2()
    Dim FindString As Variant

    With Worksheets("Sheet1")
        FindString = Application.Transpose(.Range("I2", .Cells(.Rows.Count, "I").End(xlUp).Offset(1)).Value)
    End With
    With Sheets("Sheet2").Range("A1:AZ500")
        .AutoFilter Field:=1, Criteria1:=FindString, Operator:=xlFilterValues
        If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then
            With .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Interior
                .Pattern = xlSolid
                .Color = 255
            End With
        End If
        .Parent.AutoFilterMode = False
    End With
End Sub

searching for FindString values among columns A:AZ of Sheet2

Option Explicit

Sub main2()
    Dim FindString As Variant
    Dim col As Range

    With Worksheets("Sheet1")
        FindString = Application.Transpose(.Range("I2", .Cells(.Rows.Count, "I").End(xlUp).Offset(1)).Value)
    End With

    With Sheets("Sheet2").Range("A1:AZ500")
        For Each col In .Columns
            .AutoFilter Field:=col.Column, Criteria1:=FindString, Operator:=xlFilterValues
            If Application.WorksheetFunction.Subtotal(103, col.Cells) > 1 Then
                With .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Interior
                    .Pattern = xlSolid
                    .Color = 255
                End With
            End If
            .Parent.AutoFilterMode = False
        Next
    End With
End Sub

Upvotes: 1

Related Questions