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?

 

[LearnVBA83]

All depends on your data. Double is needed for decimals. String is for text. Int and long are dependent on size of number. Variant can be anything but, don't get lazy. Use what is required. The smaller the better for performance.

Here is a reference.

Var Types

you made a good point... double is used for decimals... so wouldn't i want that since all my values are dollars with 2 decimal places?

 

[skillilea]

you made a good point... double is used for decimals... so wouldn't i want that since all my values are dollars with 2 decimal places?

Nope, if you want decimals they have to be double.

 

[LearnVBA83]

If InStr(1, ws.Range("C" & i).Value, "Expense", vbTextCompare) > 0 And ws.Range("B" & i).Value <> "" Then

I did a lot of research and i think i figured out what you're saying. Correct me if i'm wrong but will it be something like

If InStr(1, ws.Range("C" & i).Value, "Expense", vbTextCompare) > 0 And ws.Range("B" & i).Value <> "" And ws.Range("P" & i).Value <> 0 Then

 

[LearnVBA83]

I did a lot of research and i think i figured out what you're saying. Correct me if i'm wrong but will it be something like

If InStr(1, ws.Range("C" & i).Value, "Expense", vbTextCompare) > 0 And ws.Range("B" & i).Value <> "" And ws.Range("P" & i).Value <> 0 Then

Seems to work!!!!

 

[skillilea]

Nice job! Here is another way to format the code so it doesn't get unruly, again...preference

    If InStr(1, ws.Range("C" & i).Value, "Expense", vbTextCompare) > 0 _ 
        And ws.Range("B" & i).Value <> "" _ 
        And ws.Range("P" & i).Value <> 0 Then

 

[LearnVBA83]

Nice job! Here is another way to format the code so it doesn't get unruly, again...preference

    If InStr(1, ws.Range("C" & i).Value, "Expense", vbTextCompare) > 0 _
        And ws.Range("B" & i).Value <> "" _
        And ws.Range("P" & i).Value <> 0 Then

Yes I actually googled how to use _ to go to the next line so it's not ugly looking!

 

[LearnVBA83]

Hi team!

This macro is so close to being complete thanks to the wonderful help from this board. I forgot a crucial step in the code and need to adjust. Before i delete the contingent employees from this file i need to capture the totals for the contingent employee with account 6130202 and similar to the wages, benefits, fica, merit. I need to assign it a GL code of 6130202. I also need to add a column C with the word contingent beside the contingent total and the word employee by the other lines (wages, merit, fica, benefit). I've created a 4 min video to explain as well as a dummy file for dropbox.

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

Public Sub HandleRelevantWorksheets()
    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, wsCnt As Integer
    Dim lr As Long, monRow As Long, expRow As Long
    Dim rng As Range, cRow As Range, fillRangeRow As Range, target As Range
    Dim hasGLNum As Long
    Dim ar As Variant
    Dim GLFilePath As String
           
    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:A").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:A").Insert Shift:=xlToRight
                .Columns("A:A").NumberFormat = "@"
                
                ' set working range
                lr = .Cells(.Rows.Count, "C").End(xlUp).Row
                Set rng = .Range("C2:O" & lr)
                
                ' add sheet name
                .Range("A2:A" & lr).Value = "'" & numericPart
                
                ' loop through and sum expense
                For Each cRow In ws.Range("C2:C" & 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
                    
                    ' 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, 4), ws.Cells(expRow, 15))
                        fillRangeRow.Formula = "=SUM(D" & monRow & ":D" & 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
                
                ' delete contingent
                For i = ws.UsedRange.Rows.Count To 1 Step -1
                    If InStr(1, ws.Range("C" & 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("C" & i).Value, "Expense", vbTextCompare) > 0 And ws.Range("B" & i).Value <> "" _
                    And ws.Range("P" & i).Value <> 0 Then
                        Set fillRangeRow = ws.Range(ws.Cells(i, 1), ws.Cells(i, 15))
                        Set rng = mstTemp.Cells(lr, 1)
                        Set rng = rng.Resize(1, fillRangeRow.Columns.Count)
                        rng.Value = fillRangeRow.Value
    
                        lr = lr + 1
                    End If
                Next
            End With

            ' count ws success
            wsCnt = wsCnt + 1
        End If
        numericPart = ""
    Next
    
    ' clean up msttemp
    With mstTemp
        .Cells(, 3).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:N3").Value = Array("Cost Center", "GL Account", "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
        .Columns("A:A").NumberFormat = "@"
    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("C:N").HorizontalAlignment = xlRight
        .Columns("C:N").AutoFit
        .Range("C:N").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 "#FEATHERSup", , "YOUR DATA IS COMPLETE"

End Sub

 

[LearnVBA83]

2024 - Budget - Finance Results - Copy.xlsx

Shared with Dropbox

www.dropbox.com

 

[skillilea]

So you don't want to remove the contingent lines from the output and they are calculated in the Expense Totals?

 

[LearnVBA83]

So you don't want to remove the contingent lines from the output and they are calculated in the Expense Totals?

I need the contingent lines to have one line for each work sheet and to be tied to GL 6130202. I think the easy way to do it is to use the Total Cost area and tell the macro to delete every line in that area except contingents. You're already summing by expense. So the output that exists today usually has 4 lines pulled per WS and that's 100% correct. It's pulling the total wages, total merit, total fica, and total benefits NOT including the contingent. We don't split the contingent by those four areas (wage, fica, benefit, merit). I only care about one line for the contingent total going to GL 6130202. So in total each worksheet will be pulling 5 lines of data. (wages, merit, fica, benefit, contingent). I'd also love to have a column C inserted and have the word "employee" in C for (wage, merit, fica, benefit) and have the word contingent by the contingent line. If this is possible. So the macro would run like normal but would also pull in the green row below and add the column C for employee or contingent. I feel like i am being wordy. Does this make sense?