Can't get a loop to spit out individual files...

[Peacemonger2]

Hey folks! A newbie here, trying to muddle my way through saving leave balances for our employees in separate Excel files... I got the code to work once, but it will only run through the first employee and save a file for them, then it thinks it's done. I need a file for each employee when I run the code. So what am I doing wrong?

Public Function FinalizeCOMPauto()


Dim j As Long
Dim FileName As String, sSystemTime As String, sEmployeeFT As String
Dim dCompEarned As Double, dCompUsed As Double, dCompBal As Double
Dim lPeriod As Long, avDeptSummData As Variant, avMaster As Variant
Dim lLastRow As Long, lLastCol As Long, lPeriodEnd As Date, lPayDate As Date




'clear existing export file
ExportCOMP.Range("B6:B8").ClearContents
ExportCOMP.Range("G6:G10").ClearContents


'set system time for export files
sSystemTime = Format(Date, "MM/DD/YYYY")


'update command center
CommandCenter.TextBox5.BackColor = RGB(255, 155, 51)
CommandCenter.TextBox5.Text = "Running"
CommandCenter.Label14.Caption = "Processing COMP Export"

DoEvents



'READ DEPT SUMMARY TABLE TO ARRAY
'find the last row
lLastRow = DeptSummData.Range("A1000000").End(xlUp).Row

'find the last column
lLastCol = DeptSummData.Range("XFD1").End(xlToLeft).Column

'read Dept Summ Cells into array
avDeptSummData = DeptSummData.Range(DeptSummData.Cells(3, 1), DeptSummData.Cells(lLastRow, lLastCol)).Value



'read in current pay period
lPeriod = Master.Range("Q4")
lPayDate = Master.Range("I6")



'define ExportCOMP array
lLastRow = ExportCOMP.Range("A1000000").End(xlUp).Row



'find employee in the DeptSummData tab
For j = 1 To UBound(avDeptSummData, 1)
If DeptSummData.Range("E1") = lPeriod Then
sEmployeeFT = avDeptSummData(j, 1)
dCompEarned = avDeptSummData(j, 2)
dCompUsed = avDeptSummData(j, 3)
dCompBal = avDeptSummData(j, 4)




'WRITE EMPLOYEE COMP BAL INFO
ExportCOMP.Range("B6").Value = sEmployeeFT
ExportCOMP.Range("B8").Value = lPayDate
ExportCOMP.Range("G6").Value = dCompEarned
ExportCOMP.Range("G8").Value = dCompUsed
ExportCOMP.Range("G10").Value = dCompBal


'save export to file
ThisWorkbook.Worksheets("ExportCOMP").Copy
ActiveWorkbook.Worksheets("ExportCOMP").SaveAs FileName:="S:\Administration\Payroll\Paystubs\FY 2018\Comp Balances" & avDeptSummData(j, 1) & "_CompBalPP" & Master.Range("Q4")
ActiveWorkbook.Close


Exit For

End If

Next j

End Function

[Paul_Hossler]

1. Welcome to the forum -- take a minute to read the FAQs (in my sig)

I added the CODE tags for you -- you can use the [#] icon to add them next time

2. Just looking at the code, I think the marked lines are the problem

You should delete the Exit For

Option Explicit

Public Function FinalizeCOMPauto()

Dim j As Long
Dim FileName As String, sSystemTime As String, sEmployeeFT As String
Dim dCompEarned As Double, dCompUsed As Double, dCompBal As Double
Dim lPeriod As Long, avDeptSummData As Variant, avMaster As Variant
Dim lLastRow As Long, lLastCol As Long, lPeriodEnd As Date, lPayDate As Date

'clear existing export file
ExportCOMP.Range("B6:B8").ClearContents
ExportCOMP.Range("G6:G10").ClearContents

'set system time for export files
sSystemTime = Format(Date, "MM/DD/YYYY")

'update command center
CommandCenter.TextBox5.BackColor = RGB(255, 155, 51)
CommandCenter.TextBox5.Text = "Running"
CommandCenter.Label14.Caption = "Processing COMP Export"
DoEvents

'READ DEPT SUMMARY TABLE TO ARRAY
'find the last row
lLastRow = DeptSummData.Range("A1000000").End(xlUp).Row
'find the last column
lLastCol = DeptSummData.Range("XFD1").End(xlToLeft).Column

'read Dept Summ Cells into array
avDeptSummData = DeptSummData.Range(DeptSummData.Cells(3, 1), DeptSummData.Cells(lLastRow, lLastCol)).Value

'read in current pay period
lPeriod = Master.Range("Q4")
lPayDate = Master.Range("I6")
'define ExportCOMP array
lLastRow = ExportCOMP.Range("A1000000").End(xlUp).Row

'find employee in the DeptSummData tab
For j = 1 To UBound(avDeptSummData, 1)
    If DeptSummData.Range("E1") = lPeriod Then
        sEmployeeFT = avDeptSummData(j, 1)
        dCompEarned = avDeptSummData(j, 2)
        dCompUsed = avDeptSummData(j, 3)
        dCompBal = avDeptSummData(j, 4)
        
        'WRITE EMPLOYEE COMP BAL INFO
        ExportCOMP.Range("B6").Value = sEmployeeFT
        ExportCOMP.Range("B8").Value = lPayDate
        ExportCOMP.Range("G6").Value = dCompEarned
        ExportCOMP.Range("G8").Value = dCompUsed
        ExportCOMP.Range("G10").Value = dCompBal
        
        'save export to file
        ThisWorkbook.Worksheets("ExportCOMP").Copy
        ActiveWorkbook.Worksheets("ExportCOMP").SaveAs FileName:="S:\Administration\Payroll\Paystubs\FY 2018\Comp Balances" & avDeptSummData(j, 1) & "_CompBalPP" & Master.Range("Q4")
        ActiveWorkbook.Close
        
        Exit For    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< this line ...
    
    End If
    
Next j
'                   .... goes to here <<<<<<<<<<<<<<<<<<<<<<<<<<<<< and exits
End Function