Apply VBA Code to multiple specific sheets

L

LNG2013

Active Member
Joined
May 23, 2011
Messages
466
I need to apply my code to 8 different sheets. Not all 8 sheets may be present. I need help with code that will look for each sheet eg. DataA, and if present will run the code on it. When the code is finished it will then check for the next sheet.

Possible Sheets:
DataA
DataB
DataC
DataD
DataE
DataF
DataG
DataH
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Sort by date Sort by votes
Try something like

Rich (BB code): 
Dim ws As Worksheet
 
For Each ws In Worksheets
    Select Case ws.Name
        Case "DataA", "DataB", "DataC", "DataD", "DataE", "DataF", "DataG", "DataH"
            'Code here to run on those sheets, example:
            'Notice the ws. preceding the range
            'This must be done to all Range/Cells commands
 
            ws.Range("A1").Value = "Hello"
 
        Case Else
            'Do Nothing
    End Select
Next ws


That should give you something to work with.
 
Upvote 0
Something like

Code: 
Sub test()
    sheetlist = Array("DataA", "DataB", "DataC", "DataD", "DataE", "DataF", "DataG", "DataH")
    For Each sn In sheetlist
        If sheetExists(sn) Then
            With Sheets(sn)
                'do your thing here
            End With
        End If
    Next sn
End Sub
 
Function sheetExists(ByVal n As String) As Boolean
    On Error Resume Next
    sheetExists = Sheets(n).Name <> ""
End Function
Assuming sheets might not exist and you don't want this to generate errors.
 
Upvote 0
Thanks jonmo1 & Weaver I am testing out the codes now, and I'll let you know the results! Much appreciated!
 
Upvote 0
Ok so I applied both codes to test them out and I keep getting all of the formating and coding applied only to the last page of the group.

I tried adding the .ws to the Range but what do I do if it is a ".Range" if I add .ws.Range this just seems to give errors.
 
Upvote 0
Here is some of my code, let me know if you see any flags on how to adapt it to work with the Array or other solution.

I commented out the first few lines because this was code I was using to validate the sheet was there....


Code: 
'Dim WSheet As Worksheet
'Dim Found As Integer
'For Each WSheet In Worksheets
    'If LCase(WSheet.Name) = "dataa" Then
     '        Found = 1
      '       Exit For
    'End If
'Next WSheet
'If Found = 0 Then
 '    Exit Sub
'Else
 '      Sheets("ObjectiveA").Visible = True 'if it is hidden you'd get an error 'on the next line of code even though you found it above.
 '      Sheets("ObjectiveA").Select
'End If
 
'This adds the Count for the A code
    Dim LastRowF As Long
    With ActiveWorkbook.ActiveSheet
        LastRowF = .Range("F" & .Rows.Count).End(xlUp).Row
        .Range("F" & LastRowF + 3).Formula = "=COUNT(F2:F" & LastRowF & ")"
    End With
'
'This adds the P count
    Dim LastRowG As Long
    With ActiveWorkbook.ActiveSheet
        LastRowG = .Range("F" & .Rows.Count).End(xlUp).Row
        .Range("G" & LastRowG).Formula = "=COUNT(G2:G" & LastRowG - 3 & ")"
    End With
    
'This adds the V count
    Dim LastRowH As Long
    With ActiveWorkbook.ActiveSheet
        LastRowH = .Range("F" & .Rows.Count).End(xlUp).Row
        .Range("H" & LastRowH).Formula = "=COUNT(H2:H" & LastRowH - 3 & ")"
    End With
    
    
'
'This adds the R count
    Dim LastRowI As Long
    With ActiveWorkbook.ActiveSheet
        LastRowI = .Range("F" & .Rows.Count).End(xlUp).Row
        .Range("I" & LastRowI).Formula = "=COUNT(I2:I" & LastRowI - 3 & ")"
    End With
    
'
'This adds the G count
    Dim LastRowJ As Long
    With ActiveWorkbook.ActiveSheet
        LastRowJ = .Range("F" & .Rows.Count).End(xlUp).Row
        .Range("J" & LastRowJ).Formula = "=COUNT(J2:J" & LastRowJ - 3 & ")"
    End With
    
'This section of code adds gridlines to
        Dim LastRowQ As Long
         LastRowQ = Range("F" & Rows.Count).End(xlUp).Row
        Range("E1" & ":K" & LastRowQ).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With

'This adds the format to the Sub-Header
Range("A1:L1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 10
        .Color = -16777216
    End With
    Selection.Font.Bold = False
        With Selection.Interior
        .Pattern = xlSolid
        .Color = 10092543
          End With
 
Upvote 0
I took the liberty to clean it up a bit...

try

Code: 
Dim LastRow As Long, ws As Worksheet
'This adds the Count for the A code
For Each ws In Worksheets
    Select Case ws.Name
        Case "DataA", "DataB", "DataC", "DataD", "DataE", "DataF", "DataG", "DataH"
        
            With ws
                LastRow = .Range("F" & .Rows.Count).End(xlUp).Row
                
                'This adds the Count for the A code
                .Range("F" & LastRow + 3).Formula = "=COUNT(F2:F" & LastRow & ")"
            
                'This adds the P count
                .Range("G" & LastRow).Formula = "=COUNT(G2:G" & LastRow - 3 & ")"
            
                'This adds the V count
                .Range("H" & LastRow).Formula = "=COUNT(H2:H" & LastRow - 3 & ")"
            
                'This adds the R count
                .Range("I" & LastRow).Formula = "=COUNT(I2:I" & LastRow - 3 & ")"
            
                'This adds the G count
                .Range("J" & LastRow).Formula = "=COUNT(J2:J" & LastRow - 3 & ")"
            
                'This section of code adds gridlines to
                With .Range("E1" & ":K" & LastRow)
                    .Borders(xlDiagonalDown).LineStyle = xlNone
                    .Borders(xlDiagonalUp).LineStyle = xlNone
                    
                    With .Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    With .Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    With .Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    With .Borders(xlEdgeRight)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    With .Borders(xlInsideVertical)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    With .Borders(xlInsideHorizontal)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                End With
                
                'This adds the format to the Sub-Header
                With .Range("A1:L1")
                    With .Font
                        .Name = "Arial"
                        .Size = 10
                        .Color = -16777216
                        .Bold = False
                    End With
                
                    With .Interior
                        .Pattern = xlSolid
                        .Color = 10092543
                    End With
                End With
            End With
        Case Else
            'Do Nothing
    End Select
Next ws
 
Last edited:
Upvote 0
Jon you are awesome! You are a huge help to someone who is starting off in VBA much gracias!!!

There is another chunk to the code, would you mind looking at it too? This comes right after the code I just sent posted in the same sub.

Code: 
'
'This adds the formatting for the header
'
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Range("A1:L1").Select
        With Selection
        .VerticalAlignment = xlTop
    End With
    With Selection.Interior
        .ColorIndex = 33
        .Pattern = xlSolid
    End With
    Range("A1").Formula = "=Objective!N2"
    Range("A1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .ColorIndex = xlAutomatic
        .Shadow = True
    End With
    Selection.Font.ColorIndex = 2
    Selection.Font.Bold = True
 
    ' This adds formatting for Goal & Objective
    Range("L1").Select
    ActiveCell.Formula = "=B3&C3"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "Goal"
    Range("K1:L1").Select
    Selection.Font.ColorIndex = 2
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .ColorIndex = 2
    End With
    Selection.Font.Bold = True
'Adds spacing for header
        Range("E1").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = ".            .            ."
    With ActiveCell.Characters(Start:=1, Length:=23).Font
    With Selection.Font
        .Color = -13261
    End With
        End With
    Cells.Select
    Selection.Columns.AutoFit
    Selection.Rows.AutoFit
 
'
' Add total Line
'
Dim Lastrow As Long
 
    Lastrow = Range("F" & Rows.Count).End(xlUp).Row
    With Range("A" & Lastrow - 1 & ":L" & Lastrow - 1)
        With .Interior
        .ColorIndex = 33
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
        End With
    Range("A" & Lastrow).Value = "Total"
        With Range("A" & Lastrow & ":L" & Lastrow)
        With .Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 14
        End With
    End With
 
        With Range("A" & Lastrow & ":L" & Lastrow)
        With .Interior
        .ColorIndex = 36
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
       End With
'This adds the Count for for AI of 7
    Dim LastRowInd As Long
    With ActiveWorkbook.ActiveSheet
        LastRowInd = .Range("F" & .Rows.Count).End(xlUp).Row
        .Range("F" & LastRowInd + 2).Formula = "=COUNTIF(F3:F" & LastRowInd - 3 & ","">5"")"
    End With
' This adds the percentage for the AI code of 7
    Dim LastrowIndPer As Long
    LastrowIndPer = Range("F" & Rows.Count).End(xlUp).Row
    Range("E" & LastrowIndPer).Select
    ActiveCell.FormulaR1C1 = "=RC[1]/R[-2]C[1]"
    Selection.NumberFormat = "0.00%"
 
    'This adds the Independent Label
    LastrowIndW = Range("F" & Rows.Count).End(xlUp).Row
    Range("A" & LastrowIndW).Value = "Independent"
    Range("A" & LastrowIndW & ":B" & LastrowIndW).Select
        Selection.Interior.ColorIndex = 33
        Range("A" & LastrowIndW & ":F" & LastRowInd + 5).Select
        Selection.Font.Name = "Arial"
        Selection.Font.FontStyle = "Bold"
        Selection.Font.Size = 12
 
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
 
 
'This adds the Count for for AI of 5
    Dim LastRowMin As Long
    With ActiveWorkbook.ActiveSheet
        LastRowMin = .Range("F" & .Rows.Count).End(xlUp).Row
        .Range("F" & LastRowMin + 1).Formula = "=COUNTIF(F3:F" & LastRowMin - 5 & ",""=5"")"
    End With
 
'This adds the percentage for AI 5
     Dim LastrowMinPer As Long
     LastrowMinPer = Range("F" & Rows.Count).End(xlUp).Row
        Range("E" & LastrowMinPer).Select
        ActiveCell.FormulaR1C1 = "=(RC[1]+R[-1]C[1])/R[-3]C[1]"
        Selection.NumberFormat = "0.00%"
 
'This adds the Minimum Label
    LastrowMinW = Range("F" & Rows.Count).End(xlUp).Row
    Range("A" & LastrowMinW).Value = "Minimum"
    Range("A" & LastrowMinW & ":B" & LastrowMinW).Select
        Selection.Interior.ColorIndex = 35
 
 
'This adds the Count for for AI of 4
 
        Dim LastRowMod As Long
    With ActiveWorkbook.ActiveSheet
        LastRowMod = .Range("F" & .Rows.Count).End(xlUp).Row
        .Range("F" & LastRowMod + 1).Formula = "=COUNTIF(F3:F" & LastRowMod - 6 & ",""=4"")"
    End With
' This adds the percentage for AI 4
         Dim LastrowModPer As Long
     LastrowModPer = Range("F" & Rows.Count).End(xlUp).Row
        Range("E" & LastrowModPer).Select
        ActiveCell.FormulaR1C1 = "=(RC[1]+R[-1]C[1]+R[-2]C[1])/R[-4]C[1]"
        Selection.NumberFormat = "0.00%"
 
'This adds the Moderate Label
    LastrowModW = Range("F" & Rows.Count).End(xlUp).Row
    Range("A" & LastrowModW).Value = "Moderate"
    Range("A" & LastrowModW & ":B" & LastrowModW).Select
        Selection.Interior.ColorIndex = 6
 
'This adds the Count for for AI of 3
        Dim LastRowMax As Long
    With ActiveWorkbook.ActiveSheet
        LastRowMax = .Range("F" & .Rows.Count).End(xlUp).Row
        .Range("F" & LastRowMax + 1).Formula = "=COUNTIF(F3:F" & LastRowMax - 7 & ",""=3"")"
    End With
 
' This adds the percentage for AI 3
         Dim LastrowMaxPer As Long
     LastrowMaxPer = Range("F" & Rows.Count).End(xlUp).Row
        Range("E" & LastrowMaxPer).Select
    ActiveCell.FormulaR1C1 = "=(RC[1]+R[-1]C[1]+R[-2]C[1]+R[-3]C[1])/R[-5]C[1]"
        Selection.NumberFormat = "0.00%"
'This adds the Maximum Label
    LastrowMaxW = Range("F" & Rows.Count).End(xlUp).Row
    Range("A" & LastrowMaxW).Value = "Maximum"
    Range("A" & LastrowMaxW & ":B" & LastrowMaxW).Select
        Selection.Interior.ColorIndex = 3
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
Apply text to specific cell
Replies
2
Views
83
ipbr21054
I
S
  • Solved
VBA for inserting multiple photos from a specified folder
2
Replies
12
Views
621
SomeOrdinaryIndian
S
A
  • Solved
Conditional Formatting - apply rules to multiple rows based on specific cells (drop down menus)
Replies
4
Views
280
AndyB86
A
E
  • Solved
A little VBA/Macro code adjustment
Replies
3
Views
256
rollis13
rollis13
E
  • Question Question
Specific VBA Function
Replies
0
Views
218
EAlexWolfe
E

Forum statistics

Threads
1,222,239
Messages
6,164,784
Members
451,914
Latest member
mdfariborz

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top