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

 

[DougStroud]

J-
This line is missing something.... not sure
ws.Columns("n").Replace(myList(i,1), myList(i,2), xlPart)

There are only two worksheets we need to evaluate not each,
PCCombined_FF and PCCombined_VB
not every worksheet in the workbook

 

[jindon]

How about?

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

 

[DougStroud]

J-
The trim feature failed, Type mismatch error.

All the colors in col N on both sheets returned a #Value error.

 

[DougStroud]

Jindon,
Hold on a second, I have to look at something.... it is related potentially to the error

 

[DougStroud]

Nope sorry Jindon,
Did not produce colors, only error #Value

 

[jindon]

You mean no replace, no change?

 

[DougStroud]

It performed the operation but generated this error:

MasterImportSheetWebStorecolors.xls
	D	E	F	G	H	I	J	K	L	M	N
4	32305BootsBlack/White	999	SNOW	BOOT	274.99						#VALUE!
5	32305BootsBlack/White10	0	SNOW	BOOT	274.99		3256305BW			10	#VALUE!
6	32305BootsBlack/White11	0	SNOW	BOOT	274.99		3256305BW			11	#VALUE!
7	32LashedBoots06Black/Red/Grey	999	SNOW	BOOT	199.99						#VALUE!
8	32LashedBoots06Black/Red/Grey10	2	SNOW	BOOT	199.99		3256LASBGR			10	#VALUE!
9	32LashedBoots06Black/Red/Grey11	0	SNOW	BOOT	199.99		3256LASBGR			11	#VALUE!
10	32LashedBoots06Black/Red/Grey7	1	SNOW	BOOT	199.99		3256LASBGR			7	#VALUE!
11	32LashedBoots06Black/Red/Grey8	2	SNOW	BOOT	199.99		3256LASBGR			8	#VALUE!
12	32LashedBoots06Black/Red/Grey9	2	SNOW	BOOT	199.99		3256LASBGR			9	#VALUE!
13	32LashedBoots06Black/Red/Grey9.5	2	SNOW	BOOT	199.99		3256LASBGR			91/2	#VALUE!
14	32LashedBoots06Black	999	SNOW	BOOT	199.99						#VALUE!
PCCombined_FF

 

[jindon]

How about?

Sub ColorsColorFF()
     Dim Ws As Worksheet, myList, i As Long, c As Range, e
     Application.ScreenUpdating = False
    With Sheets("Color Colors")
         myList = .Range("d150",.Range("d" & Rows.Count).End(xlUp)).Resize(,2).Value
    End With
    For Each e In Array("PCCombined_FF", "PCCombined_VB")
         With Sheets(e)
               For Each c In .Range("n4", .Range("n" & Rows.Count).End(xlUp))
                   c.Value = Chr(32) & c.Value & Chr(32)
               End With
               For i = LBound(myList,1) To UBound(myList,1)
                    .Columns("n").Replace What:=myList(i,1), _
                              Replacement:=myList(i,2), LookAt:=xlPart
               Next
               For Each c In .Range("N4",.Range("N" & Rows.Count).End(xlUp))
                    c.Value = Trim(c.Value)
               Next c
         End With
    Next
Application.ActiveSheet.Calculate
Application.ScreenUpdating = True
                  
End Sub

 

[DougStroud]

J-
What is Chr(32)?
a space?

 

[jindon]

Yep.

You can confirm with entering =Char(32) in the cell (Chr in vba)