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
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