VBA: How can I make my sub-procedure dynamic to loop through a range?

jerradgarrett

New Member
Joined
Aug 24, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
I have a log that keeps track of what documents my employees have read. When they have read one in person, I manually change the color of the cell in my workbook. Then I have a macro that will look for any cells with the same document name as its value and will match the color. I want to be able to do this with all documents without having to write this macro for every document. I have tried for loops and do loops but I don't fully understand how they work.

The first sub procedure Match1 works perfectly fine for one document within a worksheet. MatchAll is where I had problems.

I get "Run-time error '1004': Method 'Range' of object '_Global' failed" a lot or "object variable or with block variable not set"

VBA Code:
Public Sub Match1()

    Dim c As Range
    Dim firstAddress As String
    
    firstAddress = Range("A10").Value

    With Range("C1:K500")
        Set c = .Find(firstAddress, LookIn:=xlValues)
        If Not c.Interior.Color = Range("A10").Interior.Color Then
            firstAddress = c.Address
            Do
                c.Interior.Color = Replace(firstAddress, firstAddress, Range("A10").Interior.Color)
                Set c = .FindNext(c)
            Loop While Not c.Interior.Color = Range("A10").Interior.Color
        End If
    End With

End Sub


VBA Code:
Public Sub MatchAll()

Dim a As Range
Dim i As Integer
Dim c As Range
Dim firstAddress As String

 
For i = 8 To 197

a = Range(1, i)

firstAddress = a.Value

        With Range("C1:K500")
            Set c = .Find(firstAddress, LookIn:=xlValues)
            If Not c.Interior.Color = a.Interior.Color Then
            firstAddress = c.Address
                Do
                    c.Interior.Color = Replace(firstAddress, firstAddress, a.Interior.Color)
                    Set c = .FindNext(c)
                Loop While Not c.Interior.Color = a.Interior.Color
         End If
        End With
        
Next i

End Sub
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Hi jerradgarrett, welcome to MrExcel.

How about ...
VBA Code:
Sub jerradgarrett()

    Dim c As Range, r As Range, i As Long
    Dim sDocument As String

    For i = 8 To 197
        Set r = Range("A" & i)
        sDocument = r.Value
        With Range("C1:K500")
            Set c = .Find(sDocument, LookIn:=xlValues)
            If Not c.Interior.Color = r.Interior.Color Then
                Do
                    c.Interior.Color = r.Interior.Color
                    Set c = .FindNext(c)
                Loop While Not c.Interior.Color = r.Interior.Color
            End If
        End With
    Next i
End Sub
 
Upvote 0
GWteb,

I just copy pasted your code and ran it to see what would happen and got a "Run Time Error 91: Object Variable or With Block Variable Not Set" over `If Not c.Interior.Color = r.Interior.Color Then`

Sorry if formatting is weird I'm used to StackOverflow and am trying to get used to this forum haha.

VBA Code:
Sub jerradgarrett()

    Dim c As Range, r As Range, i As Long
    Dim sDocument As String

    For i = 8 To 197
        Set r = Range("A" & i)
        sDocument = r.Value
        With Range("C1:K500")
            Set c = .Find(sDocument, LookIn:=xlValues)
            If Not c.Interior.Color = r.Interior.Color Then
                Do
                    c.Interior.Color = r.Interior.Color
                    Set c = .FindNext(c)
                Loop While Not c.Interior.Color = r.Interior.Color
            End If
        End With
    Next i
End Sub
 
Upvote 0
It was a derivative of your code. Just removed the redundant Replace command and modified the loop, assuming you are working with existing data.
However, the code was not as robust as it could be. This robustness is incorporated in the code below. The code currently works against the active worksheet.
VBA Code:
Sub jerradgarrett2()

    Dim c As Range, r As Range, i As Long
    Dim sDocument As String

    With ActiveSheet
        For i = 8 To 197
            Set r = .Range("A" & i)
            sDocument = CStr(r.Value)
            If Not sDocument = vbNullString Then
                With .Range("C1:K500")
                    Set c = .Find(sDocument, LookIn:=xlValues)
                    If Not c is Nothing Then
                        If Not c.Interior.Color = r.Interior.Color Then
                            Do
                                c.Interior.Color = r.Interior.Color
                                Set c = .FindNext(c)
                            Loop While Not c.Interior.Color = r.Interior.Color
                        End If
                    End If
                End With
            End If
        Next i
    End With
End Sub
 
Upvote 0
Solution
Upvote 0
Your code doesn't deal with the possibility of the value not being found.
My post #2 code did not deal with that, one of the aspects I was referring to regarding robustness, or the lack of it. IMO that's covered in my post #4 code.
 
Upvote 0
My post #2 code did not deal with that, one of the aspects I was referring to regarding robustness, or the lack of it. IMO that's covered in my post #4 code.
I copied your code from post 4, and tried running it on a value in cell A8 that was not found in cells C1:K500, and it returned error 91.
So that code does still not seem to handle unfound values.
 
Upvote 0
It works for me so I'll take it haha. Thanks.
Is there any possibility that some of the values you are searching for won't be found?
If so, have you tested that scenario out?
 
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,207
Members
452,618
Latest member
Tam84

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top