Can this be made easier???

[christianbiker]

Greetings all,

I have part of a macro that I am wondering if a loop can be applied to in order to save me from updating the macro as data is added. The code is below and any assistance would be appreciated. It is part of a bigger macro, but I just need to automate this portion.

There is a pattern of 3 cells on the same line, then it skips 6 rows and the pattern restarts. That pattern must remain constant.

Thanks!

Here is the code:

Set rngCheckRange = Range("A1,C1,E1,A7,C7,E7,A13,C13,E13,A19,C19,E19")
sImageSourceDirectory = "C:\Documents and Settings\Chad\My Documents\"

 

[xenou]

I suppose there's many ways to go about this but this would be a loop example (if you run the TestIt() sub it will create a blank workbook with a little sample data in it and highlight the ranges "checked"):

Private Sub RangeCheck()

Dim LR As Long
Dim r As Range
Dim ws As Worksheet
    
    Set ws = ActiveSheet
    
    With ws
        
        LR = .Cells(Rows.Count, 1).End(xlUp).Row '//We will stop looping when we get to the last row
        Set r = .Range("A1,C1,E1")
        
        Do While r.Cells(1).Row <= LR
            r.Interior.ColorIndex = 6 '//Test Code
            Set r = r.Offset(6)
        Loop
    
    End With

End Sub

Sub TestIt()
Dim wb As Workbook
Dim x, y, z

    '//Demonstration code
    Set wb = Workbooks.Add
    With wb.Worksheets(1)
        Randomize
        z = Int(Rnd * 1000)
        For x = 1 To 13 Step 6
            For y = 1 To 5 Step 2
                .Cells(x, y).Value = z
                z = z + 1
            Next y
        Next x
    End With
    
    Call RangeCheck
    
    wb.Saved = True
    
End Sub

 

[Peter_SSs]

Not hugely different, but this would be another looping method.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> SetRange()<br>    <SPAN style="color:#00007F">Dim</SPAN> LR <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, FR <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, rws <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> rngCheckRange <SPAN style="color:#00007F">As</SPAN> Range, rngStart <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    <SPAN style="color:#00007F">Const</SPAN> jmp <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = 6 <SPAN style="color:#007F00">'<- Change if different row 'jump'</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rngStart = Range("A1, C1, E1") <SPAN style="color:#007F00">'<- Set the first cell group</SPAN><br>    <br>    <SPAN style="color:#00007F">Set</SPAN> rngCheckRange = rngStart<br>    FR = rngStart.Row<br>    LR = Cells(Rows.Count, rngStart.Column).End(xlUp).Row<br>    rws = LR - FR + 1<br>    <SPAN style="color:#00007F">For</SPAN> r = jmp <SPAN style="color:#00007F">To</SPAN> rws <SPAN style="color:#00007F">Step</SPAN> jmp<br>        <SPAN style="color:#00007F">Set</SPAN> rngCheckRange = Union(rngCheckRange, rngStart.Offset(r))<br>    <SPAN style="color:#00007F">Next</SPAN> r<br>    rngCheckRange.Select <SPAN style="color:#007F00">'<- Just for checking code</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>