VBA Macro Loop Through worksheet

[LearnVBA83]

Is there a way to write a macro that will loop through each worksheet in workbook and copy the name of the worksheet into that worksheet in cell A1 to A200?

 

[skillilea]

Just do it before you delete the contingent files and you should be good.

Should be the same number as you start with X all the sheets you pull from.

 

[LearnVBA83]

I thought I had it but it brought in $0. I feel like I'm missing a small piece or maybe a way to store the numbers and add them together. Like you said i Dim TotalCost as Double

Before your array that you created I added

'Figure out how to grab Total cost
                TotalCost = TotalCost + Application.WorksheetFunction.Max(Range("Q:Q"))

Then towards the end I added the code to put the total cost in "E1" on the msttemp but it came in as $0 and not the total cost of all the tabs.

 'Copy Total Cost to Master Temp
             mstTemp.Range("E1") = TotalCost

This is the entire Code

Option Explicit

Private Const Wages As Long = 6120110
Private Const Merit As Long = 6120807
Private Const Fica As Long = 6120605
Private Const Benefits As Long = 6030610
Private Const Contingent As Long = 6130202

Public Sub HandleGLAndContingentWorksheets()

    Dim wb As Workbook
    Dim ws As Worksheet, mst As Worksheet, mstTemp As Worksheet
    Dim numericPart As String, char As String
    Dim i As Integer, x As Integer, wsCnt As Integer
    Dim lr As Long, monRow As Long, expRow As Long, hasGLNum As Long
    Dim rng As Range, cRow As Range, fillRangeRow As Range, target As Range
    Dim ar As Variant
    Dim sumMonths(1 To 12) As Double, contTest As Double
    Dim writeContingent As Boolean
    Dim GLFilePath As String
    Dim TotalCost As Double

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set mst = ThisWorkbook.Sheets("Master")

    'File Dialog Box
     GLFilePath = Application.GetOpenFilename(FileFilter:="Excel files (*.xlsx*), *.xlsx*", Title:="Choose an Excel file to open", MultiSelect:=False)
     If GLFilePath = "False" Then Exit Sub
     
      'clear master template
     mst.UsedRange.Clear

    Set wb = Workbooks.Open(GLFilePath)
    
    ' add a temp mst to put all value to prior transfer to Master
    On Error Resume Next
    wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count)).Name = "mstTemp"
    On Error GoTo 0
    Set mstTemp = wb.Sheets("mstTemp")
    
    For Each ws In wb.Worksheets
        numericPart = ""
        
        For i = 1 To Len(ws.Name)
            char = Mid(ws.Name, i, 1)
            If IsNumeric(char) Then
                numericPart = numericPart & char
            End If
        Next
        
        If IsNumeric(numericPart) And Len(numericPart) = 6 Then
            With ws
                              
                ' for testing...don't uncomment this line
                '.Columns("A:B").Delete Shift:=xlToLeft
                
                ' check for filter ON
                If ws.AutoFilterMode Then
                    ws.AutoFilterMode = False
                End If
                             
                ' insert column and make text type to handle 000000
                .Columns("A:B").Insert Shift:=xlToRight
                .Columns("A:A").NumberFormat = "@"
                
                ' set working range
                lr = .Cells(.Rows.Count, "D").End(xlUp).Row
                Set rng = .Range("D2:P" & lr)

                ' add sheet name
                .Range("A2:A" & lr).Value = "'" & numericPart

                ' loop through and sum expense
                For Each cRow In ws.Range("D2:D" & lr).Rows
                    Set target = cRow.Cells(, 1)
                    
                    ' add the GL Codes
                    If InStr(1, target.Value, "Wages", vbTextCompare) > 0 Then hasGLNum = Wages
                    If InStr(1, target.Value, "Merit", vbTextCompare) > 0 Then hasGLNum = Merit
                    If InStr(1, target.Value, "Fica", vbTextCompare) > 0 Then hasGLNum = Fica
                    If InStr(1, target.Value, "Benefits", vbTextCompare) > 0 Then hasGLNum = Benefits
                    
                    ' switch contingent tracking
                    If InStr(1, target.Value, "Total FTEs", vbTextCompare) > 0 Then writeContingent = True
                    If InStr(1, target.Value, "Wages", vbTextCompare) > 0 Then writeContingent = False
            
                    ' mark the contingent lines
                    If writeContingent And InStr(1, target.Value, "Contingent", vbTextCompare) > 0 Then
                        cRow.Cells(, -1).Value = "contingent"
                    End If

                    ' find the month row
                    If Trim(target.Offset(, 1).Value) = "Jan" Then
                        monRow = cRow.Row + 1
                    End If

                    ' find  expense
                    If Trim(target.Value) = "Expense" Then
                        expRow = cRow.Row
                        If hasGLNum > 0 Then target.Offset(, -1).Value = hasGLNum
                    End If


                    ' if we have both, put sum, fill across
                    If monRow > 0 And expRow > 0 Then
                        Set fillRangeRow = ws.Range(ws.Cells(expRow, 5), ws.Cells(expRow, 16))
                        fillRangeRow.Formula = "=SUM(E" & monRow & ":E" & expRow - 1 & ")"

                        monRow = 0
                        expRow = 0
                        hasGLNum = 0
                    End If

                    ' if we need to write GL do it
                    If hasGLNum > 0 Then target.Offset(, -1).Value = hasGLNum
                Next
                
                'Figure out how to grab Total cost
                TotalCost = TotalCost + Application.WorksheetFunction.Max(Range("Q:Q"))
                
                ' initialize the array
                For x = 1 To 12
                    sumMonths(x) = 0
                Next

                ' add contingent values
                For i = 1 To .UsedRange.Rows.Count
                    If .Cells(i, "B").Value = "contingent" Then
                        For x = 5 To 16
                            If IsNumeric(ws.Cells(i, x).Value) Then
                                sumMonths(x - 4) = sumMonths(x - 4) + ws.Cells(i, x).Value
                            End If
                        Next
                    End If
                Next

                ' delete contingent
                For i = ws.UsedRange.Rows.Count To 1 Step -1
                    If InStr(1, ws.Range("D" & i).Value, "Contingent", vbTextCompare) > 0 Then
                       ws.Cells(i, 1).EntireRow.Delete
                    End If
                Next
    
                ' overwrite with just values
                With .UsedRange
                    .Value = .Value
                End With

                ' copy expenses to master temp
                lr = mstTemp.Cells(.Rows.Count, "A").End(xlUp).Row + 1
                mstTemp.Columns("A:A").NumberFormat = "@"
                For i = 1 To .UsedRange.Rows.Count
                    If InStr(1, ws.Range("D" & i).Value, "Expense", vbTextCompare) > 0 And ws.Range("C" & i).Value <> "" _
                    And ws.Range("Q" & i).Value <> 0 Then
                        Set fillRangeRow = ws.Range(ws.Cells(i, 1), ws.Cells(i, 16))
                        Set rng = mstTemp.Cells(lr, 1)
                        Set rng = rng.Resize(1, fillRangeRow.Columns.Count)
                        rng.Value = fillRangeRow.Value
    
                        lr = lr + 1
                    End If
                Next
               
               
                ' copy contingent to master file
                contTest = 0
                For x = 1 To 12
                    contTest = contTest + sumMonths(x)
                Next
                
                If contTest <> 0 Then
                     With mstTemp
                        lr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                        .Range("A" & lr).Value = numericPart
                        .Range("C" & lr).Value = Contingent
                        .Range("D" & lr).Value = "Contingent"
                    For x = 1 To 12
                            .Cells(lr, x + 4).Value = sumMonths(x)
                    Next
                End With
            End If
        End With

            ' count ws success
            wsCnt = wsCnt + 1
        End If
        numericPart = ""
    Next
    
            'Copy Total Cost to Master Temp
             mstTemp.Range("E1") = TotalCost
             
       
    ' clean up msttemp
    With mstTemp
        .Cells(, 2).EntireColumn.Delete
        .Rows("1:2").Insert Shift:=xlDown
        .Range("A1:E1").Merge
        .Range("A1").Value = "Ws Success Count: " & wsCnt & Space(10) & Format(Now(), "mm/dd/yyyy hh:mm:ss AM/PM")
        .Range("A3:O3").Value = Array("Cost Center: Code", "GL Account", "Staffing Type", "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
        .Columns("A:A").NumberFormat = "@"
        .Range("C:C").Replace What:="Expense", Replacement:="Job"
    End With

    ' copy to masterfile
    ar = mstTemp.UsedRange.Value
    mst.UsedRange.Clear
    mst.Columns("A:A").NumberFormat = "@"
    Set rng = mst.Range("A1").Resize(UBound(ar, 1), UBound(ar, 2))
    rng.Value = ar

    ' some formmating
    With mst
        .Rows("3").Font.Bold = True
        .Range("A:O").HorizontalAlignment = xlRight
        .Columns("A:O").AutoFit
        .Range("D:O").NumberFormat = "_(* #,##0.00_);_(* -#,##0.00;_(* """"??_);_(@_)"
    End With

    ' delete the mstTemp sheet
    mstTemp.Delete

    ' close the wb
    wb.Close SaveChanges:=False

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    Set wb = Nothing
    Set ws = Nothing
    Set mst = Nothing
    Set mstTemp = Nothing

MsgBox "Macro Complete", , "YOUR DATA IS COMPLETE"

End Sub

 

[skillilea]

try this

TotalCost = TotalCost + Application.WorksheetFunction.Max(.Range("Q:Q"))

You are inside a loop with the ws so you need the "." or it points to the active sheet.

 

[LearnVBA83]

try this

TotalCost = TotalCost + Application.WorksheetFunction.Max(.Range("Q:Q"))

You are inside a loop with the ws so you need the "." or it points to the active sheet.

Wow that one "." made it work! So i brought the amount into the Master Sheet in Cell G1. Now all i need to do is add everything on the Master template and subtract it from G1 so that if it's zero then it ties! I'll probably have some type of error message if it's not zero. What is the best way to sum the master sheet. Looks like the way you wrote the code is it will always start on D4 and goes to O (Dec). Is there a way to make it figure out the rows during the sum? Like the endxl.up code?

 

[skillilea]

Don't make it complicated.

mst.range("H1").formula= WorksheetFunction.Sum("G:G")   

'not sure what your ranges are but let excel do the work

' apply conditional formatting to the cell if they both don't match

 

[LearnVBA83]

Hmmmm. I got this error

 

[LearnVBA83]

Does it need to be something like this?

'Sum Master Template
mst.Range("H1").Formula = WorksheetFunction.Sum("D4:O" & end(xlup))

 

[LearnVBA83]

I got this to work but it's also adding the amount in G1. I need to figure out how to tell it to start on D4 and go to last row.

'Sum Master Template
mst.Range("H1").Formula = WorksheetFunction.Sum(Range("D:O"))

 

[skillilea]

could use just

mst.Range("H1").Formula = "=SUM(D:0)"

 

[LearnVBA83]

So we wrote the below to find the Total cost of all the worksheets.

 'Figure out how to grab Total cost
                TotalCost = TotalCost + Application.WorksheetFunction.Max(.Range("Q:Q"))

Can i skip pasting that amount to msttemp and just go straight to this code? It seems to work. I'm just not sure if it's best practice.

 'Copy Total Cost to Master and subtract from template total
        mst.Range("G1") = WorksheetFunction.Sum(Range("D:O")) - TotalCost