0

I have pieced together this macro VBA that works perfectly. However, I need to run the same code on multiple sheets in the same workbook. I've tried many things i've seen online (SubWorksheetLoop2, etc) and am having no luck. The goal is to use this code below and have it run through all the pages of my workbook. The names of my tabs are 'CLASS II', 'CLASS III', etc. Please advise! 

Option Explicit
Sub InsertBetweenV3()
Dim Area As Range
Dim r As Long, lr As Long, sr As Long, er As Long, i
enter code here
'  turn off screen updating
Application.ScreenUpdating = False
enter code here
'  create an array to fill the 6 inserted rows
i = Array("", "OBS", "VIOL", "VIOL RATE", "STATEMENT", "")
enter code here
enter code here
'  activate/select the first worksheet
Worksheets(1).Activate
enter code here
'  lr is for last row.  Find the last row in column 1 = column A
lr = Cells(Rows.Count, 1).End(xlUp).Row
'  when we are inserting/deleting rows we usually start from the bottom up
For r = lr To 3 Step -1
'  Range("A" & r) is not equal to Range("A" & r - 1)
' If A1535 is not equal to A1534 Then
  If Cells(r, 1) <> Cells(r - 1, 1) Then
' insert 6 rows
 Rows(r).Resize(6).Insert
  End If
Next r

' now that we have inserted six empty rows for each change in STATION
' find the new last row in column 1 = column A
lr = Cells(Rows.Count, 1).End(xlUp).Row
' for each Area in range A1:A new last row
' Area will find each group of rows between the inserted 6 rows
For Each Area In Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
' with each Area
With Area
'  sr a variable for start row
'  the .Row of the Area is the first row of the Area sr = .Row
  sr = .Row
' er a variable for end row
 ' is equal to sr + count of rows in the Area – 1
 ' er = sr + .Rows.Count – 1

    er = sr + .Rows.Count - 1

' beginning in the blank inserted 6 rows
 ' transpose the i array vertically
    Cells(er + 1, 1).Resize(6).Value = Application.Transpose(i)
' in the first blank row change the interior color to Gray
'  from column 1 = column A to column 46 = column AT
    Cells(er + 1, 1).Resize(, 68).Interior.ColorIndex = 15
' bold the text inserted from the i array
    Cells(er + 2, 1).Resize(4).Font.Bold = True
  ' in the last blank row change the interior color to Gray
  '   from column 1 = column A to column 46 = column AT
    Cells(er + 6, 1).Resize(, 68).Interior.ColorIndex = 15
    ' put the formula in the appropriate cells to do the calculations
Range("G" & er + 2).Formula = "=COUNTIF(G" & sr & ":G" & er & ","">0"")"
Range("G" & er + 3).Formula = "=SUM(COUNTIF(G" & sr & ":G" & er & ", ""<6""),COUNTIF(G" & sr & ":G" & er & ","">9""),-COUNTIF(G" & sr & ":G" & er & ",""=0""))"
Range("G" & er + 4).Formula = "=(G" & er + 3 & "/G" & er + 2 & ")*100"
Range("K" & er + 2).Formula = "=COUNTIF(K" & sr & ":K" & er & ","">0"")"
Range("K" & er + 3).Formula = "=COUNTIF(K" & sr & ":K" & er & ","">32"")
Range("K" & er + 4).Formula = "=(K" & er + 3 & "/K" & er + 2 & ")*100"
Range("I" & er + 2).Formula = "=COUNTIF(I" & sr & ":I" & er & ","">0"")"
Range("I" & er + 3).Formula = "=SUM(COUNTIF(I" & sr & ":I" & er & ",""<4""),-COUNTIF(I" & sr & ":I" & er & ",""=0""))"
Range("I" & er + 4).Formula = "=(I" & er + 3 & "/I" & er + 2 & ")*100"
Range("S" & er + 2).Formula = "=COUNTIF(S" & sr & ": S" & er & ","">0"")"
Range("S" & er + 3).Formula = "=COUNTIF(S" & sr & ": S" & er & ","">235"")"
Range("S" & er + 4).Formula = "=(S" & er + 3 & "/ S" & er + 2 & ")*100"
Range("U" & er + 2).Formula = "=COUNTIF(U" & sr & ":U" & er & ","">0"")"
Range("U" & er + 3).Formula = "=COUNTIF(U" & sr & ":U" & er & ","">104"")"
Range("U" & er + 4).Formula = "=(U" & er + 3 & "/U" & er + 2 & ")*100"
  End With
Next Area
' find the last row in column 1 = column A
lr = Cells(Rows.Count, 1).End(xlUp).Row
' in the following ranges change the number format
Range("G2:G" & lr).NumberFormat = "0.000"
Range("K2:K" & lr).NumberFormat = "0.000"
Range("S2:S" & lr).NumberFormat = "0.000"
Range("U2:U" & lr).NumberFormat = "0.000"
' turn back on screen updating
Application.ScreenUpdating = True
End Sub
aLearningLady
  • 1,988
  • 4
  • 24
  • 42
Doliver
  • 1
  • 1

2 Answers2

1

Worksheets can be identified by their Worksheet .CodeName property, Worksheet .Name property or Worksheet.Index property among others.

A large number of worksheets with a small number of exclusions is probably best sought after with an index based loop.

dim w as long
for w = 1 to worksheets.count
    with worksheets(w)
        if .name <> "Master" and .name <> "Summary" then
            'do some stuff with the worksheet(s)
        end if
    end with
next w

If you have a limited number of specific worksheets, then the .name(s) can be put into an array.

dim v as long, vWSs as variant
vWSs = array("CLASS II", "CLASS III", "CLASS IV")
for v = lbound(vWSs) to ubound(vWSs)
    with worksheets(vWSs(v))
        'do some stuff with the worksheet(s)
    end with
next v

Those are two methods that work well in different situations. The worksheet codename is best for referencing worksheets abstractly; perhaps as a destination to a copy/paste from within one of the above loops.

0

While not as elegant or dynamic as other methods, you could use a simple For loop:

For iCount = 1 to 99 'number of Worksheets 
Worksheets(iCount).select
'Insert your code here
Next
Brady Spiva
  • 11
  • 4