Ask Me Help Desk

Ask Me Help Desk (https://www.askmehelpdesk.com/forum.php)
-   Spreadsheets (https://www.askmehelpdesk.com/forumdisplay.php?f=395)
-   -   Loop for payslips needed. (https://www.askmehelpdesk.com/showthread.php?t=346359)

  • Apr 26, 2009, 03:34 PM
    rsdjimbie
    1 Attachment(s)
    Loop for payslips needed.
    Please refer to attached worksheet.
    I need a loop that will fill cells marked in yellow on sheet "PaySlip", with data read from sheet "All Dpts" starting at R4C2 and ending when col. C is blank. There are blank rows between R4 and R1111, because these deprtments as shown in Col A, shrink and expaned all the time. I need all in sheet "All Dpts" col. 2 read to "PaySlip" sheet in order to produce payslips for all workers.
  • Apr 26, 2009, 06:39 PM
    JBeaucaire
    1 Attachment(s)

    All right, here's the macro:
    Code:

    Option Explicit
    Sub PrintPayStubs()
    Dim i As Long, lastrow As Long, MaxNum As Long
    Dim CancelDate As Variant, RngNum As Range, RngClk As Range

    CancelDate = Application.InputBox("What is the paydate?")
        If CancelDate = False Or CancelDate = "" Then
            MsgBox "No Date entered, aborting print routine..."
            Exit Sub
        End If

    Sheets("Payslip").Activate
    Sheets("Payslip").Range("G2").Value = CancelDate
    lastrow = Sheets("All Dpts").Range("B" & Rows.Count).End(xlUp).Row
    Sheets("All Dpts").Range("AG4:AG" & lastrow).FormulaR1C1 = "=IF(RC2="""",R[-1]C,R[-1]C+1)"
    Set RngNum = Sheets("All Dpts").Range("AG4:AG" & lastrow)
    Set RngClk = Sheets("All Dpts").Range("B4:B" & lastrow)

    MaxNum = WorksheetFunction.Max(RngNum)

        For i = 1 To MaxNum Step 6    'change maxnum to some small number to test short runs
            Range("A4").Value = WorksheetFunction.Index(RngClk, WorksheetFunction.Match(i, RngNum, 0))
            Range("A21").Value = WorksheetFunction.Index(RngClk, WorksheetFunction.Match(i + 1, RngNum, 0))
            Range("A38").Value = WorksheetFunction.Index(RngClk, WorksheetFunction.Match(i + 2, RngNum, 0))
            Range("A55").Value = WorksheetFunction.Index(RngClk, WorksheetFunction.Match(i + 3, RngNum, 0))
            Range("A72").Value = WorksheetFunction.Index(RngClk, WorksheetFunction.Match(i + 4, RngNum, 0))
            Range("A89").Value = WorksheetFunction.Index(RngClk, WorksheetFunction.Match(i + 5, RngNum, 0))
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
        Next i

    Sheets("All Dpts").Columns("AG").ClearContents
    End Sub

    This macro inserts CLK numbers into the yellow cells, as you requested. The only way this works though is for each of the payslips to reach over and grab matching info from the All Dpts sheet with an INDEX/MATCH. I've adjusted this version to do that, including matching the formats of paystubs 2-6 to paystub 1. Also, all the text entries on paystub 1 flows to the other stubs, so you only need adjust stub1 to adjust them all!

    I've added button to start the Print Paystubs process. The only thing NOT on the All Dpts sheet was PAY DATE... so I made the macro ask you for that at the beginning.

    Also, you'll have to work with SICK LEAVE formulas, I couldn't figure out what you had in mind there with no sick leave examples in the data set.

    Give it a look.

    NOTE: If you want to test this macro on a shorter run of printouts, change this line of the code:
    Code:

    For i = 1 To MaxNum Step 6
    ... change "MaxNum" to some smaller number, like 12 or 18 to get the first 2 or 3 pages (it prints 6 per page). Be sure to set it back to "MaxNum" before you use it for real.
  • Apr 27, 2009, 05:03 AM
    rsdjimbie
    Repeat pages already printed.


    Code:

    Option Explicit
    Sub PrintPayStubs()
    Dim i As Long, lastrow As Long, MaxNum As Long
    Dim CancelDate As Variant, RngNum As Range, RngClk As Range

    CancelDate = Application.InputBox("What is the paydate?")
        If CancelDate = False Or CancelDate = "" Then
            MsgBox "No Date entered, aborting print routine..."
            Exit Sub
        End If

    Sheets("Payslip").Activate
    Sheets("Payslip").Range("G2").Value = CancelDate
    lastrow = Sheets("All Dpts").Range("B" & Rows.Count).End(xlUp).Row
    Sheets("All Dpts").Range("AG4:AG" & lastrow).FormulaR1C1 = "=IF(RC2="""",R[-1]C,R[-1]C+1)"
    Set RngNum = Sheets("All Dpts").Range("AG4:AG" & lastrow)
    Set RngClk = Sheets("All Dpts").Range("B4:B" & lastrow)

    MaxNum = WorksheetFunction.Max(RngNum)

        For i = 1 To MaxNum Step 6  'change maxnum to some small number to test short runs
            Range("A4").Value = WorksheetFunction.Index(RngClk, WorksheetFunction.Match(i, RngNum, 0))
            Range("A21").Value = WorksheetFunction.Index(RngClk, WorksheetFunction.Match(i + 1, RngNum, 0))
            Range("A38").Value = WorksheetFunction.Index(RngClk, WorksheetFunction.Match(i + 2, RngNum, 0))
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
        Next i

    Sheets("All Dpts").Columns("AG").ClearContents
    End Sub

  • Apr 27, 2009, 05:15 AM
    rsdjimbie
    Don't wory about repeat print mentioned earlier I have sorted it out.
    Thanks a mil Jerry.

  • All times are GMT -7. The time now is 05:10 AM.