• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA macro to generate a print output for multiple persons. One person, one worksheet for printing.

S

SAM SAM

New Member
Hello everyone! it has been decades since ive done VBA macros. I have already done the first half of the macro, wherein i have transferred the data that i need for the printout. (from "raw data" worksheet to "sheet1" worksheet.) But i couldn't do the rest of the macro, which is to transfer the data to another worksheet for printing. Thank you in advance! It will be such a big help if someone can help me with this macro. =)
 

Attachments

  • IWC MACRO.xlsm
    78.4 KB · Views: 6

SAM SAM​

This is my way sample solution for this.
Check Voucher-sheet.
.Why do You want to have 12 same kind of sheets there?
You can see one sheet in time ... then there needs to be one sheet (Voucher-sheet).
Select MODE: ALL / SINGLE
Select OUTPUT: PRN / PDF / SCR
(( Note: for PDF - there have to be PDF-folder in same folder with this sample file ))
[ START ] will work with PRN & PDF
Otherwise select THERAPIST to get Your way results to OUTPUT.
... I would use a different layout
Questions?
 

Attachments

  • IWC MACRO.xlsb
    44.3 KB · Views: 3
Hello SAM², if you need your original layout as it is with worksheets '1' to '12' then​
according to your initial post attachment a way where you must first delete :​
  • 'Sheet1' worksheet
  • 'Module1' VBA module …
You forgot to create '7' worsheet ! So duplicate '8' worksheet before itself and rename it as '7' …​
​
Once done, try this VBA demonstration to paste only to the 'raw data' worksheet module :​
Code: 
Sub Demo1()
        Const F = "B6:B#&C6:C#&"" - ""&D6:D#&"" ""&E6:E#&"" ""&F6:F#&"" (""&G6:G#&"") - ""&H6:H#&"" HR"""
   With [A1].CurrentRegion
        V = Application.Index(.Rows(1), 1, [{1,3,6,8,9,14,10,16}])
       .Columns(4).AdvancedFilter 2, , [AF1], True
        [AF1].CurrentRegion.Sort [AF1], 1, Header:=1
        W = Application.Transpose(Range("AF2", [AF1].End(xlDown)))
    For N% = 1 To 12
        S$ = N
     If Not IsError(Evaluate("'" & S & "'!A1")) Then
        Sheets(S).UsedRange.Offset(5).Clear
     If N > UBound(W) Then
        Sheets(S).[C1] = "Therapist"
     Else
        Sheets(S).[B5:I5] = V
        [AF2] = W(N)
       .AdvancedFilter 2, [AF1:AF2], Sheets(S).[B5:I5]
   With Sheets(S).[A5].CurrentRegion.Columns
       .Item(5).Replace "INFINITY SIGNATURE MASSAGE", "INF", 2
       .Item(5).Replace "INFINITY", "INF", 2
       .Item(5).Replace "FOOT REFLEX", "FOOT", 2
       .Item(6).Replace "SPA SIESTA", "SS", 2
       .Item(9).Font.Name = .Cells(9).Font.Name
       .Item(9).Interior.ColorIndex = xlNone
        R = .Rows(.Rows.Count).Row
        X = Application.Sum(.Item(8))
   End With
   With Sheets(S)
        .[C1] = W(N)
        .[I5] = "AMOUNT"
        .Range("B6:B" & R) = Application.Text(.Range("B6:B" & R), "mmm-dd-yy ddd: ")
        .Range("A6:A" & R) = .Evaluate(Replace(F, "#", R))
        .Range("I6:I" & R + 1).HorizontalAlignment = 1
        .Range("I6:I" & R + 1).NumberFormat = "# ###_W"
   With .Rows(R + 1).Columns("A:I")
        .Font.Color = vbRed
        .Formula = Array("TOTAL", , X, "HR" & IIf(X > 1, "S", ""), , , , , "=SUM(I6:I" & R & ")")
   End With
        .Range("B5:H" & R).Clear
   End With
     End If
     End If
    Next
   End With
        [AF1].CurrentRegion.Clear
End Sub
Do you like it ? So thanks to click on bottom right Like !​
​
 
Hello Marc!

Your code works perfectly! Thank you soooo much!!! You're a lifesaver!

Thank you so much!

Regards,
Samsam
 
Last edited by a moderator:
Rather than using sheets "1" to "12" why not just generating sheets according to therapists' names ?​
And do you really need this weird concatenation instead of the Excel usual columns layout ?​
​
 
Marc L said:
Rather than using sheets "1" to "12" why not just generating sheets according to therapists' names ?​
And do you really need this weird concatenation instead of the Excel usual columns layout ?​
​
Click to expand...
That should be the case, but Im just a novice when it comes to VBA macros. I record macros and edit hehe.

i am printing it on a printed form. The form has only 2 columns; one column for all the details, the other column is for the amount. But then again, because of my skills, i cannot do it properly. =)
 

SAM SAM​

As I've asked
... why more than one sheet for outputs?
... did You check my version?
... ... there are option for printout & for PDF
... ... ... and the output could be already done without any specific printed form (which information missed from Your details)
 
SAM SAM said:
That should be the case
Click to expand...
So why not just well explaining your need with a well reflecting attachment rather than letting helpers to guess ?!​
Printing on a form can use a standard Excel columnar format without any concatenation …​
​
Anyway, according to your initial post attachment my VBA revamped demonstration which first deletes all worksheets after 'raw data'​
then generates all therapists' names worksheets, to still paste only to the 'raw data' worksheet module :​
Code: 
Sub Demo1r()
        Const F = "B6:B#&C6:C#&"" - ""&D6:D#&"" ""&E6:E#&"" ""&F6:F#&"" (""&G6:G#&"") - ""&H6:H#&"" HR"""
   With Application
        V = .Index([A1:P1], 1, [{1,3,6,8,9,14,10,16}])
       .ScreenUpdating = False
     If Worksheets.Count > Index Then
       .DisplayAlerts = False
        Worksheets(Evaluate("TRANSPOSE(ROW(" & Index + 1 & ":" & Worksheets.Count & "))")).Delete
       .DisplayAlerts = True
     End If
        UsedRange.Columns(4).AdvancedFilter 2, , [AF1], True
        [AF1].CurrentRegion.Sort [AF1], 2, Header:=1
    For Each W In Range("AF2", [AF1].End(xlDown)).Value
        [AF2] = W
   With Sheets.Add(, Me)
       .Name = W
       .[B5:I5] = V
        [A1].CurrentRegion.AdvancedFilter 2, [AF1:AF2], .[B5:I5]
  With .[A5].CurrentRegion.Columns
       .Item(5).Replace "INFINITY SIGNATURE MASSAGE", "INF", 2
       .Item(5).Replace "INFINITY", "INF", 2
       .Item(5).Replace "FOOT REFLEX", "FOOT", 2
       .Item(6).Replace "SPA SIESTA", "SS", 2
       .Item(9).Font.Name = .Cells(9).Font.Name
       .Item(9).Interior.ColorIndex = xlNone
       .Offset(1).Font.Size = 12
       .Rows(-2).HorizontalAlignment = 7
        R = .Rows(.Rows.Count).Row
        X = Application.Sum(.Item(8))
  End With
       .[A2].Font.Size = 16
       .[A2] = W
       .[A5,I5].Font.Underline = 2
       .[A5] = "PARTICULARS"
       .[I5].HorizontalAlignment = xlCenter
       .[I5] = "AMOUNT"
       .Range("B6:B" & R) = Application.Text(.Range("B6:B" & R), "mmm-dd-yy ddd: ")
       .Range("A6:A" & R) = .Evaluate(Replace(F, "#", R))
       .Range("I6:I" & R - (R > 6)).HorizontalAlignment = 1
       .Range("I6:I" & R - (R > 6)).NumberFormat = "# ###_W"
     If R > 6 Then
  With .Rows(R + 1).Columns("A:I")
       .Font.Color = vbRed
       .Formula = Array("TOTAL", , X, IIf(X > 1, "HRS", "HR"), , , , , "=SUM(I6:I" & R & ")")
  End With
     End If
       .Range("B5:H" & R).Clear
   End With
    Next
        [AF1].CurrentRegion.Clear
       .ScreenUpdating = True
   End With
End Sub
You may Like it !​
​
 
vletm said:

SAM SAM​

As I've asked
... why more than one sheet for outputs?
... did You check my version?
... ... there are option for printout & for PDF
... ... ... and the output could be already done without any specific printed form (which information missed from Your details)
Click to expand...
Hi Vietm!

Im so sorry, i missed your file! I viewed your post with my phone and didnt notice the file.

ive downloaded the file now, but couldnt push any of the button on sheet voucher. I have unblocked the file from windows.

Thank you so much for your help!! Much appreciation!

Regards,
Samsam
 
Marc L said:
So why not just well explaining your need with a well reflecting attachment rather than letting helpers to guess ?!​
Printing on a form can use a standard Exel columnar format without any concatenation …​
​
Anyway according to your initial post attachment my VBA revamped demonstration which first deletes all worksheets after 'raw data'​
then generates all therapists' names worksheets, to still paste only to the 'raw data' worksheet module :​
Code: 
Sub Demo1r()
        Const F = "B6:B#&C6:C#&"" - ""&D6:D#&"" ""&E6:E#&"" ""&F6:F#&"" (""&G6:G#&"") - ""&H6:H#&"" HR"""
   With Application
        V = .Index([A1:P1], 1, [{1,3,6,8,9,14,10,16}])
       .ScreenUpdating = False
     If Worksheets.Count > Index Then
       .DisplayAlerts = False
        Worksheets(Evaluate("TRANSPOSE(ROW(" & Index + 1 & ":" & Worksheets.Count & "))")).Delete
       .DisplayAlerts = True
     End If
        UsedRange.Columns(4).AdvancedFilter 2, , [AF1], True
        [AF1].CurrentRegion.Sort [AF1], 2, Header:=1
    For Each W In Range("AF2", [AF1].End(xlDown)).Value
        [AF2] = W
   With Sheets.Add(, Me)
       .Name = W
       .[B5:I5] = V
        [A1].CurrentRegion.AdvancedFilter 2, [AF1:AF2], .[B5:I5]
  With .[A5].CurrentRegion.Columns
       .Item(5).Replace "INFINITY SIGNATURE MASSAGE", "INF", 2
       .Item(5).Replace "INFINITY", "INF", 2
       .Item(5).Replace "FOOT REFLEX", "FOOT", 2
       .Item(6).Replace "SPA SIESTA", "SS", 2
       .Item(9).Font.Name = .Cells(9).Font.Name
       .Item(9).Interior.ColorIndex = xlNone
       .Offset(1).Font.Size = 12
       .Rows(-2).HorizontalAlignment = 7
        R = .Rows(.Rows.Count).Row
        X = Application.Sum(.Item(8))
  End With
       .[A2].Font.Size = 16
       .[A2] = W
       .[A5,I5].Font.Underline = 2
       .[A5] = "PARTICULARS"
       .[I5].HorizontalAlignment = xlCenter
       .[I5] = "AMOUNT"
       .Range("B6:B" & R) = Application.Text(.Range("B6:B" & R), "mmm-dd-yy ddd: ")
       .Range("A6:A" & R) = .Evaluate(Replace(F, "#", R))
       .Range("I6:I" & R - (R > 6)).HorizontalAlignment = 1
       .Range("I6:I" & R - (R > 6)).NumberFormat = "# ###_W"
     If R > 6 Then
  With .Rows(R + 1).Columns("A:I")
       .Font.Color = vbRed
       .Formula = Array("TOTAL", , X, IIf(X > 1, "HRS", "HR"), , , , , "=SUM(I6:I" & R & ")")
  End With
     End If
       .Range("B5:H" & R).Clear
   End With
    Next
        [AF1].CurrentRegion.Clear
       .ScreenUpdating = True
   End With
End Sub
You may Like it !​
​
Click to expand...
Sorry for that. Noted on this. Will be clear next time on the needed output. Thanks for the advice. =)

i tried to run the revised code. It has this error.

1712766054266.png
 

SAM SAM​

Yes - that won't neither work with mobilephone!
You can always download it again.
I added here 'instructions' ... You skipped to ask those.
Those blue texts are only in below snapshot.
You should able to move mouse over those cells and 'click' to do selection
There are none buttons.
Screenshot 2024-04-10 at 19.39.32.png
You file has some links to somewhere ... I didn't break those.
Still - why You need more than one sheet for printing or seeing it?
 
oh i got it! It is indeed my bad. I learned many things from you. Thank you so much!!!
 
Last edited by a moderator:
You must log in or register to reply here.
Back
Top