PDA

View Full Version : Can't get a loop to spit out individual files...



Peacemonger2
03-22-2018, 03:15 PM
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?:think:


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
03-22-2018, 04:00 PM
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