Looping through Block of Code

[DougStroud]

I have a large number of lines of code that I need to repeat on another sheet. The criteria for the code is the same, but the parameters are different, i.e. the last row, the name of the sheet, etc...
Rather than creating another procedure I was curious if I can loop through the following code and created new variable, sheet objects to carry out the instructions on the other sheet?
The following code is significantly reduced- I have about 500 total lines of replace, so don't gauge it soley by what you see here-- I did this to save everyone the pain...

Sub ColorsColorFF()
     Dim Ws As Worksheet, c As Range, rng As Range
     Dim LRow As Long, LRow1 As Long, LRow2 As Long
     Dim i As Long

     Set Ws = ActiveSheet
     LRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

     Application.ScreenUpdating = False

For Each c In Range("N4:N" & LRow)
        c.Formula = " " & c & " "
    Next c

    With Ws
          For Each c In Intersect(Ws.Columns(14), Ws.UsedRange)
'Workbook("Color Subs.xls").Worksheets(
'Single Color Term Swap- #3
If InStr(c.Value, " 60S ") > 0 Then c.Formula = Replace(c.Value, " 60S ", "Denim-Washes")
If InStr(c.Value, " Amber ") > 0 Then c.Formula = Replace(c.Value, " Amber ", "Yellow")
If InStr(c.Value, " Amethyst ") > 0 Then c.Formula = Replace(c.Value, " Amethyst ", "Purple")
If InStr(c.Value, " Aqua ") > 0 Then c.Formula = Replace(c.Value, " Aqua ", "Turquoise")
If InStr(c.Value, " Argyle ") > 0 Then c.Formula = Replace(c.Value, " Argyle ", "Print")
     End With

For Each c In Range("N4:N" & LRow)
  c.Value = Application.WorksheetFunction.Trim(c.Value)
Next c


'     For Each c In rng
'            c.Value = Application.WorksheetFunction.Trim(c.Value)
'            Next c

Application.ActiveSheet.Calculate
Application.ScreenUpdating = True
                  
End Sub

 

[zzjasonzz]

in the sub definition add the variables you want i.e.

Sub ColorsColorFF(Ws As Worksheet, LRow as Long )

then when you call it you pass the same ones in

call ColorsColorFF(activesheet, 100)

then when it runs through it will create ws = activesheet and LRow = 100

i hope you get the general idea..

 

[stanleydgromjr]

Doug,

Your code uses "Set Ws = ActiveSheet". I can not see anything specific to a sheetname.

You should be able to run this macro on the other sheets. You may have to put the code in a 'Module'.

Have a great day,
Stan

 

[zzjasonzz]

I assumed there was more code that needed it, obviously you wouldn't need to pass activesheet to a function.

If it isn't in a module go to the VBA window (Alt-F11) then right click on microsoft excel objects on the left of the screen and go Insert > Module

 

[jindon]

Hi
How about Find & replace?

Sub ColorsColorFF()
     Dim Ws As Worksheet, myList, i As Long, c As Range
     Application.ScreenUpdating = False
    myList = [{" 60S ", "Denim-Washes";" Amber ","Yellow"; " Amethyst ", "Purple"; " Aqua ", "Turauoise"; " Argyle ", "Print"}]
    For Each ws In Worksheets
         With ws.Range("n4", ws.Range("n" & Rows.Count).End(xlUp))
              .Value = Evaluate(""" "" & "&" & .Address & "" """)
         End With
         For i = LBound(myList,1) To UBound(myList,1)
              ws.Columns("n").Replace(myList(i,1), myList(i,2), xlPart)
         Next
        For Each c In ws.Range("N4",.Range("N" & Rows.Count).End(xlUp))
             c.Value = Trim(c.Value)
        Next c
    Next
Application.ActiveSheet.Calculate
Application.ScreenUpdating = True
                  
End Sub

 

[DougStroud]

Hello Jason and Stan and Jindon,
Jason and Stan I was reading through your post's when Jindon dropped in. So bare w/ me while I run some things by him.

Jindon-
My list is big- will I need to transform it int the array?

Here it is... I will delete it after we use it for reference...
[code]If InStr(c.Value, " 60S ") > 0 Then c.Formula = Replace(c.Value, " 60S ", "Denim-Washes")
If InStr(c.Value, " Amber ") > 0 Then c.Formula = Replace(c.Value, " Amber ", "Yellow")

 

[jindon]

Doug

Can you make a list on the sheet?

That will be much easier to maintain.

 

[DougStroud]

I have a list in another worksheet that I update to creat any new entries or edits, if that is what you mean.

I have cobbled together a formula that I just paste into my code window.

Is that what you are referring to?

 

[DougStroud]

J-
Here is a sample of my code:

Color Subs.xls
	C	D	E	F
150	3	Stone	Lt.Tan
151	3	Stp	Stripe
152	3	Striped	Stripe
153	3	Taupe	Lt.Grey
154	3	Tbg	Denim-Washes
155	3	Tea	Lt.Green
156	3	Tobacco	Brown
157	3	Tree	Print
158	3	Treez	Print
159	3	Vin	Denim-Washes
160	3	Vintage	Denim-Washes
161	3	Walnut	Brown
162	3	Wheat	Lt.Yellow
163	3	Wine	Dk.Red
164	3	Winter	Lt.Blue
165	3	Wood	Print
166	2	Amber/Clear	Yellow+
167	2	Army/Gum	Olive+
168	2	Ash/White	Lt.Grey+
169	2	Beige/Black	Lt.Tan+
170	2	Black/Black	Black+
171	2	Black/Black/Black	Black+
172	2	Black/Black/Red/Silver	Black+
Color Colors

 

[jindon]

Then try this

Sub ColorsColorFF()
     Dim Ws As Worksheet, myList, i As Long, c As Range
     Application.ScreenUpdating = False
    With Sheets("Color Colors")
         myList = .Range("d150",.Range("d" & Rows.Count).End(xlUp)).Resize(,2).Value
    End With
    For Each ws In Worksheets
         With ws.Range("n4", ws.Range("n" & Rows.Count).End(xlUp))
              .Value = Evaluate(""" "" & "&" & .Address & "" """)
         End With
         For i = LBound(myList,1) To UBound(myList,1)
              ws.Columns("n").Replace(myList(i,1), myList(i,2), xlPart)
         Next
        For Each c In ws.Range("N4",.Range("N" & Rows.Count).End(xlUp))
             c.Value = Trim(c.Value)
        Next c
    Next
Application.ActiveSheet.Calculate
Application.ScreenUpdating = True
                  
End Sub