2 issues with Macros (Setting Pages to Print & Not copying data when worksheet is Blank)

RalphMHill

New Member
Joined
Mar 7, 2017
Messages
1
Hello,

I am working on a Spreadsheet for my business (a Template for my Job Estimates) and need a little assistance. I have 2 issues on 2 different macros.

FIRST: I have a Macro CopyToMain() that runs when you click a button on the MATERIALS worksheet. The Macro copies all of the data from other worksheets on this Main Materials worksheet. However if one of the worksheets is Blank the Macro moves 3 Rows from the other Worksheet to the Materials worksheet, that should not move (i.e., It should skip that worksheet or Not move anything. The only way I found around it was to put a Period (.) in the First Cell (F19:AB19) manually.

SECOND: I have incorporated another Macro PageNumberFormat() into the one above, and for troubleshooting left it in the worksheet as well. The problem is that I want this Macro to to figure out the Number of Pages on the Selected Sheet and 1, fill the information into Cells (AN2:AP2) and (AU2:AW2); and second set the page setup accordingly for Printing and/or Saving to PDF file. Currently it fills the Cells with incorrect information (I.e. there are 3 Pages, and it says 1 to 11).

Any and all assistance will be greatly appreciated. Spreadsheet attached.

FIRST MACRO:

Sub CopyToMain()

Dim ws As Worksheet, wsMain As Worksheet, wsCover As Worksheet
Dim wsLabor As Worksheet
Dim fPATH As String
Dim PR As Long, NR As Long, LR As Long
Dim xVPC As Integer, xHPC As Integer, xNumPage As Integer
Dim xVPB As VPageBreak, xHPB As HPageBreak


fPATH = "C:\Users\Mine\Desktop\Your Handyman\ESTIMATES"

Set wsMain = ThisWorkbook.Sheets("Materials")
Set wsCover = ThisWorkbook.Sheets("Cover_Page")
Set wsLabor = ThisWorkbook.Sheets("Labor")

Sheets("MATERIALS").Select
Rows("19:1018").Select
Selection.Delete Shift:=xlUp
Range("AT17:BA17").Select

With wsMain
LR = .Range("A" & .Rows.Count).End(xlUp).Row
If LR > 4 Then
.Rows("19:" & LR + 10).EntireRow.RowHeight = 15
' .Range("A19:A" & LR).EntireRow.Clear
End If
NR = 19
End With
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> wsMain.Name And ws.Name <> wsCover.Name And ws.Name <> wsLabor.Name Then
With ws
LR = .Range("F" & .Rows.Count).End(xlUp).Row
If LR > 4 Then
.Range("A19:BA" & LR).Copy wsMain.Range("A" & NR)
NR = wsMain.Range("A" & Rows.Count).End(xlUp).Row + 1
End If
End With
End If
Next ws
NR = NR - 1
With wsMain
.Range("A19:D19").Copy .Range("A20:D" & NR)
With .Range("A19:A" & NR)
.Formula = "=ROW(A1)"
.Value = .Value
End With
Application.PrintCommunication = False
With .PageSetup
.PrintArea = "$A$1:$BA$" & NR + 1
.Zoom = False
.FitToPagesWide = 1
' .FitToPagesTall = 1
End With

Sheets("MATERIALS").Select
Application.PrintCommunication = False
With .PageSetup
.PrintArea = "$A$1:$BA$" & NR + 1
.Zoom = False
.FitToPagesWide = 1
End With


xHPC = 1
xVPC = 1
If ActiveSheet.PageSetup.Order = xlDownThenOver Then
xHPC = ActiveSheet.HPageBreaks.Count + 1
Else
xVPC = ActiveSheet.VPageBreaks.Count + 1
End If
xNumPage = 1
For Each xVPB In ActiveSheet.VPageBreaks
If xVPB.Location.Column > ActiveCell.Column Then Exit For
xNumPage = xNumPage + xHPC
Next
For Each xHPB In ActiveSheet.HPageBreaks
If xHPB.Location.Row > ActiveCell.Row Then Exit For
xNumPage = xNumPage + xVPC
Next
'AN2:AP2
Range("AN2:AP2").Select
ActiveCell = xNumPage

Range("AU2:AW2").Select
ActiveCell = xNumPage & Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")
' ActiveCell = "Page " & xNumPage & " of " & Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")

Range("AT17:BA17").FormulaR1C1 = "=SUM(R19C46:R507C53)"

Application.PrintCommunication = True
If MsgBox("Print To PDF?", vbYesNo, "PRINT") = vbYes Then
wsMain.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPATH & .[F2].Value & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
End With
End Sub

SECOND MACRO

Sub PageNumberFormat()

Dim xVPC As Integer
Dim xHPC As Integer
Dim xVPB As VPageBreak
Dim xHPB As HPageBreak
Dim xNumPage As Integer
xHPC = 1
xVPC = 1
If ActiveSheet.PageSetup.Order = xlDownThenOver Then
xHPC = ActiveSheet.HPageBreaks.Count + 1
Else
xVPC = ActiveSheet.VPageBreaks.Count + 1
End If
xNumPage = 1
For Each xVPB In ActiveSheet.VPageBreaks
If xVPB.Location.Column > ActiveCell.Column Then Exit For
xNumPage = xNumPage + xHPC
Next
For Each xHPB In ActiveSheet.HPageBreaks
If xHPB.Location.Row > ActiveCell.Row Then Exit For
xNumPage = xNumPage + xVPC
Next
'AN2:AP2
Range("AN2:AP2").Select
ActiveCell = xNumPage

Range("AU2:AW2").Select
ActiveCell = xNumPage & Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")

' ActiveCell = "Page " & xNumPage & " of " & Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")
End Sub



Any and all assistance will be appreciated


I can Email worksheet if required since the Forum will not allow me to Attach files
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Forum statistics

Threads
1,214,951
Messages
6,122,449
Members
449,083
Latest member
Ava19

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top