How can I modify my code to offset the defined range and repeat theprocedure instead of duplicating

N

najisaadat

Happy Friday Excel Community! I could really use some help with this.
I have the following code but I want it to offset and repeat the
srcRng for different ranges. I pretty much need this sub procedure to
be repeated for

ckRng("F4:Y4"), ckRng("F6:Y6"), ckRng("F8:Y8"), etc. How can I do
this? Offset the range? Add another loop? I tried a couple things but
it didn't work! Thanks a bunch for any help!

Sub colorMe()
Dim srcRng As Range, ckRng As Range, Clr As Range
Set srcRng = ActiveSheet.Range("C64:C67")
Set ckRng = ActiveSheet.Range("F4:Y4")

Ship1 = Worksheets("Sheet1").Range("C64").Value
Ship2 = Worksheets("Sheet1").Range("C65").Value
Ship3 = Worksheets("Sheet1").Range("C66").Value
Ship4 = Worksheets("Sheet1").Range("C67").Value


For Each c In ckRng
Set Clr = srcRng.Find(c.Value, LookIn:=xlValues)
If Not Clr Is Nothing Then
Select Case Clr.Value

Case Ship1
c.Offset(-1, 0).Interior.ColorIndex = 0
Case Ship2
c.Offset(-1, 0).Interior.ColorIndex = 7
Case Ship3
c.Offset(-1, 0).Interior.ColorIndex = 6
Case Ship4
c.Offset(-1, 0).Interior.ColorIndex = 8



End Select
End If
Next
End Sub
 
J

JLGWhiz

1. Do you want to move the ckRng exactly two rows on each iteration?

2. And for how many rows? (i.e. What is the final row to check?)
 
N

najisaadat

Hey JLG!

Yes, exactly 2 rows on each iteration, with the last row for ckRng
being F116:Y116.

Thanks a bunch JLG, you are a true Whiz!
 
J

JLGWhiz

Try this:

Sub colorMe()
Dim srcRng As Range, ckRng As Range, Clr As Range
Set srcRng = ActiveSheet.Range("C64:C67")
Ship1 = Worksheets("Sheet1").Range("C64").Value
Ship2 = Worksheets("Sheet1").Range("C65").Value
Ship3 = Worksheets("Sheet1").Range("C66").Value
Ship4 = Worksheets("Sheet1").Range("C67").Value
For i = 4 To 116 Step 2
Set ckRng = ActiveSheet.Range("F" & i & ":Y" & i)
For Each c In ckRng
Set Clr = srcRng.Find(c.Value, LookIn:=xlValues)
If Not Clr Is Nothing Then
Select Case Clr.Value
Case Ship1
c.Offset(-1, 0).Interior.ColorIndex = 0
Case Ship2
c.Offset(-1, 0).Interior.ColorIndex = 7
Case Ship3
c.Offset(-1, 0).Interior.ColorIndex = 6
Case Ship4
c.Offset(-1, 0).Interior.ColorIndex = 8
End Select
End If
Next
Next
End Sub



Hey JLG!

Yes, exactly 2 rows on each iteration, with the last row for ckRng
being F116:Y116.

Thanks a bunch JLG, you are a true Whiz!
 
N

najisaadat

Works like a charm! Thanks!

Try this:

Sub colorMe()
   Dim srcRng As Range, ckRng As Range, Clr As Range
   Set srcRng = ActiveSheet.Range("C64:C67")
   Ship1 = Worksheets("Sheet1").Range("C64").Value
   Ship2 = Worksheets("Sheet1").Range("C65").Value
   Ship3 = Worksheets("Sheet1").Range("C66").Value
   Ship4 = Worksheets("Sheet1").Range("C67").Value
   For i = 4 To 116 Step 2
     Set ckRng = ActiveSheet.Range("F" & i & ":Y" & i)
     For Each c In ckRng
     Set Clr = srcRng.Find(c.Value, LookIn:=xlValues)
       If Not Clr Is Nothing Then
          Select Case Clr.Value
           Case Ship1
              c.Offset(-1, 0).Interior.ColorIndex = 0
           Case Ship2
              c.Offset(-1, 0).Interior.ColorIndex = 7
           Case Ship3
              c.Offset(-1, 0).Interior.ColorIndex = 6
           Case Ship4
              c.Offset(-1, 0).Interior.ColorIndex = 8
          End Select
       End If
     Next
     Next
End Sub


Hey JLG!

Yes, exactly 2 rows on each iteration, with the last row for ckRng
being F116:Y116.

Thanks a bunch JLG, you are a true Whiz!






- Show quoted text -
Click to expand...
 
Top