Help!! Need to run macro on multiple worksheets...

[G_Olson]

I have multiple worksheets that I need to run the same macro on. I've tried several code examples I found online to do this, but none of them will work using my code (which works fine on individual worksheets). They work fine when running "as is", but won't cycle through the worksheets when I insert my code. The macro just keeps running on the first worksheet multiple times instead of stepping through them!?

Here's some simple code I tried that worked fine "as is"...


Public Sub BoldAllSheets()
Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
ws.Range("1:1").Font.Bold = True
Next ws

End Sub


When I replace ws.Range("1:1").Font.Bold = True with my code it will NOT cycle through the worksheets. Again, it just runs multiple times on the first worksheet. I can email files/code if needed. Any help would be much appreciated.

 

[VoG]

Please post the code that isn't working.

 

[G_Olson]

Hi VoG,

Here's my code. Again, it works fine when running on a single worksheet...just can't get it to cycle through multiple worksheets (If I have 10 worksheets, it just runs on the first worksheet 10 times!!). Some background info...the purpose of the macro is to take address information and rearrange it so that all the info for each address is in a separate record (i.e. on the same line).

Sub testmac1()
'
' testmac1 Macro
'
 
'
Rows("1:9").Select
Range("A9").Activate
Selection.Delete Shift:=xlUp
Range("A1").Select
ActiveCell.FormulaR1C1 = "Address"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Name"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Telephone"
Columns("C:C").Select
Selection.ColumnWidth = 10.71
Range("D1").Select
ActiveCell.FormulaR1C1 = "Distance"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Side"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Description"
Range("G1").Select
Selection.UnMerge
Cells.Select
Selection.UnMerge
Selection.Columns.AutoFit
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlLeft
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.ColumnWidth = 17.43
Columns("H:K").Select
Selection.Delete Shift:=xlToLeft
Range("D2:D108").Select
Selection.Cut
Range("F2").Select
ActiveSheet.Paste
Range("A2:B103").Select
Selection.Cut
Range("D2").Select
ActiveSheet.Paste
Range("C2:C104").Select
Selection.Cut
Range("A2").Select
ActiveSheet.Paste
Range("G2:H104").Select
Selection.Cut
Range("B2").Select
ActiveSheet.Paste
 
' testmac3 Macro
 
Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-5]&"", ""&R[1]C[-5]"
Range("G2").Select
Selection.Copy
Range("G3:G200").Select
ActiveSheet.Paste
Range("G2:G200").Select
Application.CutCopyMode = False
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("G:G").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
 
' testmac4 Macro
 
Columns("F:F").ColumnWidth = 40.14
Selection.ColumnWidth = 56.86
Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]&"",""&R[1]C[-1]"
Range("G2").Select
Selection.Copy
Range("G3:G200").Select
ActiveSheet.Paste
Range("G2:G200").Select
Application.CutCopyMode = False
Selection.Copy
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("G:G").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
 
' delete_rows Macro
 
Range( _
"3:3,5:5,7:7,9:9,11:11,13:13,15:15,17:17,19:19,21:21,23:23,25:25,27:27,29:29,31:31,33:33,35:35,37:37" _
).Select
Range("A37").Activate
ActiveWindow.SmallScroll Down:=36
Union(Range( _
"67:67,69:69,71:71,3:3,5:5,7:7,9:9,11:11,13:13,15:15,17:17,19:19,21:21,23:23,25:25,27:27,29:29,31:31,33:33,35:35,37:37,39:39,41:41,43:43,45:45,47:47,49:49,51:51,53:53,55:55,57:57,59:59" _
), Range("61:61,63:63,65:65")).Select
Range("A71").Activate
ActiveWindow.SmallScroll Down:=30
Union(Range( _
"67:67,69:69,71:71,73:73,75:75,77:77,79:79,81:81,83:83,85:85,87:87,89:89,91:91,93:93,95:95,97:97,99:99,101:101,103:103,105:105,107:107,109:109,111:111,3:3,5:5,7:7,9:9,11:11,13:13,15:15,17:17,19:19" _
), Range( _
"21:21,23:23,25:25,27:27,29:29,31:31,33:33,35:35,37:37,39:39,41:41,43:43,45:45,47:47,49:49,51:51,53:53,55:55,57:57,59:59,61:61,63:63,65:65" _
)).Select
Range("A111").Activate
ActiveWindow.SmallScroll Down:=42
Union(Range( _
"67:67,69:69,71:71,73:73,75:75,77:77,79:79,81:81,83:83,85:85,87:87,89:89,91:91,93:93,95:95,97:97,99:99,101:101,103:103,105:105,107:107,109:109,111:111,113:113,115:115,117:117,119:119,121:121,123:123,125:125,127:127,129:129" _
), Range( _
"131:131,133:133,135:135,137:137,139:139,141:141,143:143,145:145,147:147,149:149,3:3,5:5,7:7,9:9,11:11,13:13,15:15,17:17,19:19,21:21,23:23,25:25,27:27,29:29,31:31,33:33,35:35,37:37,39:39,41:41,43:43,45:45" _
), Range("47:47,49:49,51:51,53:53,55:55,57:57,59:59,61:61,63:63,65:65")).Select
Range("A149").Activate
ActiveWindow.Zoom = 85
ActiveWindow.Zoom = 70
ActiveWindow.Zoom = 55
ActiveWindow.Zoom = 40
ActiveWindow.Zoom = 55
ActiveWindow.Zoom = 70
ActiveWindow.Zoom = 85
ActiveWindow.Zoom = 100
ActiveWindow.SmallScroll Down:=120
Union(Range( _
"67:67,69:69,71:71,73:73,75:75,77:77,79:79,81:81,83:83,85:85,87:87,89:89,91:91,93:93,95:95,97:97,99:99,101:101,103:103,105:105,107:107,109:109,111:111,113:113,115:115,117:117,119:119,121:121,123:123,125:125,127:127,129:129" _
), Range( _
"131:131,133:133,135:135,137:137,139:139,141:141,143:143,145:145,147:147,149:149,151:151,153:153,155:155,157:157,159:159,161:161,163:163,165:165,167:167,169:169,171:171,173:173,175:175,177:177,179:179,181:181,183:183,185:185,187:187,189:189,191:191,193:193" _
), Range( _
"195:195,197:197,199:199,3:3,5:5,7:7,9:9,11:11,13:13,15:15,17:17,19:19,21:21,23:23,25:25,27:27,29:29,31:31,33:33,35:35,37:37,39:39,41:41,43:43,45:45,47:47,49:49,51:51,53:53,55:55,57:57,59:59" _
), Range("61:61,63:63,65:65")).Select
Range("A199").Activate
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=-180
 
Dim c As Range
Dim rng As Range
For Each c In Intersect(ActiveSheet.UsedRange, Columns("f"))
If c = "," Then
If rng Is Nothing Then Set rng = c.EntireRow
Set rng = Union(rng, c.EntireRow)
End If
Next c
rng.Select
 
End Sub

Thanks

 

[VoG]

Try like this

Sub testmac1()
'
' testmac1 Macro
'

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    With ws
        .Range("A9").Delete Shift:=xlShiftUp
        .Range("A1:F1").Value = Array("Address", "Name", "Telephone", "Distance", "Side", "Description")
        .Columns("C").ColumnWidth = 10.71
    '
    ' and so on
    '
    End With
Next ws
End Sub

 

[MrKowz]

Tried cleaning up your code a bit. Hope it all fires right:

Sub testmac1()
'
' testmac1 Macro
'
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
With ws
    .Rows("1:9").Delete Shift:=xlUp
    .Range("A1").Value = "Address"
    .Range("B1").Value = "Name"
    .Range("C1").Value = "Telephone"
    .Columns("C:C").ColumnWidth = 10.71
    .Range("D1").Value = "Distance"
    .Range("E1").Value = "Side"
    .Range("F1").Value = "Description"
    With .Cells
        .UnMerge
        .Columns.AutoFit
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .HorizontalAlignment = xlLeft
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .ColumnWidth = 17.43
    End With
    .Columns("H:K").Delete Shift:=xlToLeft
    .Range("D2:D108").Cut Destination:=Range("F2")
    .Range("A2:B103").Cut Destination:=Range("D2")
    .Range("C2:C104").Cut Destination:=Range("A2")
    .Range("G2:H104").Cut Destination:=Range("B2")
' testmac3 Macro
    .Range("G2").FormulaR1C1 = "=RC[-5]&"", ""&R[1]C[-5]"
    .Range("G2").Copy Destination:=Range("G3:G200")
    .Range("G2:G200").Copy
    .Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    .Columns("G:G").Delete Shift:=xlToLeft
' testmac4 Macro
    .Columns("F:F").ColumnWidth = 56.86
    .Range("G2").FormulaR1C1 = "=RC[-1]&"",""&R[1]C[-1]"
    .Range("G2").Copy Destination:=Range("G3:G200")
    .Range("G2:G200").Copy
    .Range("F2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    .Columns("G:G").Delete Shift:=xlToLeft
' delete_rows Macro
    Dim i as Long
    Dim delrng As Range
    For i = 3 To 149 Step 2
        Set delrng = Union(delrng, .Rows(i))
    Next i
    delrng.Delete Shift:=xlUp
    Dim c As Range
    Dim rng As Range
    For Each c In Intersect(.UsedRange, .Columns("f"))
        If c = "," Then
            If rng Is Nothing Then Set rng = c.EntireRow
            Set rng = Union(rng, c.EntireRow)
        End If
    Next c
    rng.Select
 
End With
Next ws
End Sub

 

[G_Olson]

VoG,

Tried it, but no luck. Same thing occurs...just keeps running on the first worksheet. The code that I posted works...just not when I embed in code to run on each worksheet.

Mr Kowz...I tried your code, too, but I get a Run-time error '5': Invalid procedure call or argument on Set delrng = Union(delrng, .Rows(i))

I am TOTALLY new to this stuff...just started playing around with it yesterday...so forgive if I come across as a little lost at times. My code is kind of messy because I recorded the macro.

If the code works on one worksheet, should it not work on multiples when embedded in the multiple worksheet code??? I'm a little baffled. Maybe would be easier/make more sense if I could send data so you can see exactly what I'm trying to accomplish???

 

[VoG]

I just tested the bit of code that I posted and it entered the headers in row 1 of every sheet. Did you try just that snippet of code? You'll need to check the sheets after running because it doesn't do any selecting, just writes the headers.

 

[G_Olson]

VoG,

Yeah...I just tried the bit that you sent and that worked. Weird that my code will work on a single worksheet, but not cycle through multiple worksheets.

 

[VoG]

No it isn't weird. You need to follow the syntax that MrKowz and I have given you.

 

[G_Olson]

Following to the letter....won't work. I inserted my code in the stuff you sent me as follows:

Sub VoG()

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
With ws
(**My code** - Works on a single worksheet)
End With
Next ws
End Sub


No go. I set breakpoints to run stepwise. It doesn't want to perform the last step (below) when I have it embedded in the worksheet loop.

Dim c As Range
Dim rng As Range
For Each c In Intersect(ActiveSheet.UsedRange, Columns("f"))
If c = "," Then
If rng Is Nothing Then Set rng = c.EntireRow
Set rng = Union(rng, c.EntireRow)
End If
Next c
rng.Select