Need a faster way to print commission reports

Cryov · Aug 26, 2014

I am printing out commission reports on a weekly basis for about 600 employees and having to manually highlight the area and use print selection is very tedious and wearing on me.

The amount of columns is the same (A-L) but the amount of rows varies due to how many commissions they've done.

Example:

Technician Name: Doe, John <-- each commission start with this
*varying rows of commission details that go through columns A to L*
Totals Technician Name: Doe, John <-- each commission ends with this

I figure there must be a way to set up a custom print range from Tech Name: XXXXXX to Totals Technician Name: XXXXX either through some formula or VBA coding.

Any help is greatly appreciated!

par60056 · Aug 26, 2014

Welcome to the forum.

This should be a pretty easy task to automate using VBA. It should be a simple matter of looping through the sheet, when you notice the name change, set up the PageSetup object and print it.

As with all tasks to automate, I usually start by recording doing it manually for a couple and then editing the recorded macro. If you record doing it manually and post the code, somebody will help generalize it.

Cryov · Aug 26, 2014

My knowledge of VBA is very limited, I doubt I could do more than slightly tweak whatever VBA code is given to me.
Also to point out, I can't setup a static point because the amount of commissions changes week to week. I am just wanting something to setup a print area from one point to the other with the names as a variable

Technician Name: Doe, John

Technician Role: TECH

Inv. Date

Invoice

Location

Location Name

Service

Inv. Amount

Appl. Date

Pay. Amount

Tech.

Commission

Paid On

Commission Due

Split

*various data for columns and amount of rows changes week to week*

Totals Technician Name: Doe, John

par60056 · Aug 26, 2014

The problem is that I can't write the code to do what you want without either a bit of recorded code that show doing it by hand or a sample sheet of the input and the reports printed.

I do this all the time. This should be something I can write in under an hour if I have the samples. If I just write something generic, you would need to be able to figure out how to make it work for your specific situation.

The thing that I am working on right now gets data from the database and creates 5 reports from it repeated for various periods.

Snakehips · Aug 26, 2014

Cryov,

Give this a try.

Right click your sheet tab >> View Code >>> Paste the below code into the code pane where the cursor is blinking.

Run the code by hitting F5 or by whatever means you choose, e.g. assign it to a shape or a keyboard shortcut.
Test it as it is i.e. doing a print preview, on a small data set. You can dismiss the option to print during the test.
Notes in code tell you how to change to direct printing if you wish.

Code:

Sub Print_Com()
Dim ws As Worksheet




tn = "Technician Name:" 'Top search string in Column A


ttn = "Totals Technician Name:" ' Bottom search string in A


Set ws = ActiveSheet
os = 0
Set Rng = Range("A1:A100")  ' start  range alows for up to Approx 100 rows per technician


lr = Cells(Rows.Count, "A").End(xlUp).Row 'Last row in col A


Do
On Error Resume Next
tr = 0
ttr = o
tr = WorksheetFunction.Match(tn, Rng, 0)  ' find start
ttr = WorksheetFunction.Match(ttn, Rng, 0) 'find end
On Error GoTo 0
If tr + ttr = 0 Then Exit Sub  ' quit if can't find search strings
'set print area
ws.PageSetup.PrintArea = Range("A" & tr + pos & ":L" & ttr + pos).Address


'to remove print preview and just print
'add a leading apostrophe to the line below *****
'and remove the leading apostrophe from the line below that @@@@@
' print
ws.PrintPreview '*****


'ws.PrintOut  '@@@@@
' make adjustments to offset the range downwards so can search for next techie
pos = os + ttr
os = ttr
Set Rng = Rng.Offset(os, 0)
Rng.Select
' do again
Loop
End Sub

Hope that helps.

Cryov · Aug 27, 2014

That coding doesn't seem to work from what I can tell.

https://docs.google.com/spreadsheets/d/1Yd6tLVb1bQ9WHl_-zv8o2_TGasRckZH2slr6VKD3PHY/edit?usp=sharing

I've uploaded an example of what it looks like, granted I edited out the names for privacy reasons.
Keep in mind this is 300 rows, I have to deal with 30,000 rows of this.

Basically I just want to be able to find an efficient way to print this besides sitting for 2-3 hours to highlight and print selection.
To re-iterate, the amount of commissions they do varies week to week so one week they may have 50 rows worth of work and next week 100 rows.

If I could simply put a page break behind each "Totals Technician Name:" but not have it shrink 3 pages worth of data to 1 and making it to small to read.

par60056 · Aug 27, 2014

ok I took your data and put it in a sheet. Then I recorded the macro of printing the first 2.

Code:

Sub Macro1()
'
' Macro1 Macro
'


'
    Range("A1").Select
    ActiveWindow.SmallScroll Down:=72
    Range("A1:L89").Select
    ActiveSheet.PageSetup.PrintArea = "$A$1:$L$89"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    ActiveWindow.SmallScroll Down:=75
    Range("A91").Select
    ActiveWindow.SmallScroll Down:=93
    Range("A91:L189").Select
    ActiveSheet.PageSetup.PrintArea = "$A$91:$L$189"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
End Sub

Then I went and wrote a more general routine adding in the rest of the page setup items you might want to change.

Code:

Sub printTech()
Dim techStartRow As Long
Dim lastRow As Long
Dim currRow As Long


lastRow = ActiveSheet.UsedRange.Rows.Count
For currRow = 1 To lastRow
    If Left(Cells(currRow, 1), 16) = "Technician Name:" Then
        techStartRow = currRow
    ElseIf Left(Cells(currRow, 1), 23) = "Totals Technician Name:" Then
        ActiveSheet.PageSetup.PrintArea = "$A$" & techStartRow & ":$L$" & currRow
        ' you may want to do other things with the page setup
        With ActiveSheet.PageSetup
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = Application.InchesToPoints(0.25)
            .RightMargin = Application.InchesToPoints(0.25)
            .TopMargin = Application.InchesToPoints(0.75)
            .BottomMargin = Application.InchesToPoints(0.75)
            .HeaderMargin = Application.InchesToPoints(0.3)
            .FooterMargin = Application.InchesToPoints(0.3)
            .PrintHeadings = False
            .PrintGridlines = False
            .PrintComments = xlPrintNoComments
            .CenterHorizontally = False
            .CenterVertically = False
            .Orientation = xlLandscape
            .Order = xlDownThenOver
            .BlackAndWhite = False
            .Zoom = False
            .FitToPagesWide = 1
        End With
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    End If
Next
End Sub

par60056 · Aug 27, 2014

having run a test printout, you might want to add the line:
.PrintTitleRows = "$" & techStartRow & ":$" & (techStartRow+2)

After the line "With ActiveSheet.PageSetup"

and widen column L so the title fits.

Snakehips · Aug 27, 2014

Cryov,

I had assumed that 'Technician Name:' would be in column A and the name would be in column B and similar with the Totals.

Given that you have the names appended to those strings I have made a very small change to my code by adding wildcards in with those strings. Also I have added a line to ensure that the print is landscape, which I assume is what you want?

Try this.......

Code:

Sub Print_Com()
Dim ws As Worksheet

tn = "Technician Name:*" 'Top search string in Column A

ttn = "Totals Technician Name:*" ' Bottom search string in A

Set ws = ActiveSheet
os = 0
Set Rng = Range("A1:A100")  ' start  range alows for up to Approx 100 rows per technician


lr = Cells(Rows.Count, "A").End(xlUp).Row 'Last row in col A


Do
On Error Resume Next
tr = 0
ttr = o
tr = WorksheetFunction.Match(tn, Rng, 0)  ' find start
ttr = WorksheetFunction.Match(ttn, Rng, 0) 'find end
On Error GoTo 0
If tr + ttr = 0 Then Exit Sub  ' quit if can't find search strings
'set print area and orientation
ws.PageSetup.PrintArea = Range("A" & tr + pos & ":L" & ttr + pos).Address
ws.PageSetup.Orientation = xlLandscape


'to remove print preview and just print
'add a leading apostrophe to the line below *****
'and remove the leading apostrophe from the line below that @@@@@
' print
ws.PrintPreview '*****

'ws.PrintOut  '@@@@@
' make adjustments to offset the range downwards so can search for next techie
pos = os + ttr
os = ttr
Set Rng = Rng.Offset(os, 0)
Rng.Select
' do again
Loop
End Sub

par60056 · Aug 27, 2014

Nope, looking closer, the roles may change from page to page.

Need a faster way to print commission reports

Cryov

New Member

Excel Facts

par60056

Well-known Member

Cryov

New Member

par60056

Well-known Member

Snakehips

Well-known Member

Cryov

New Member

par60056

Well-known Member

par60056

Well-known Member

Snakehips

Well-known Member

par60056

Well-known Member

Similar threads

Forum statistics

Share this page

Need a faster way to print commission reports

New Member

Excel Facts

Well-known Member

New Member

Well-known Member

Well-known Member

New Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock