View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
JLGWhiz[_2_] JLGWhiz[_2_] is offline
external usenet poster
 
Posts: 1,565
Default How can I modify my code to offset the defined range and repeat the procedure instead of duplicating my code?

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



wrote in message
...
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!


On May 29, 1:06 pm, "JLGWhiz" wrote:
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?)

wrote in message

...



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- Hide quoted text -


- Show quoted text -