ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,832
- Office Version
- 2007
- Platform
- Windows
Hi,
The code in use is shown below.
The code does all as expected apart from copying the value from sheet INV cell L4 & then pasting it in customers row line on sheet DATABASE cell P
The code in use is shown below.
The code does all as expected apart from copying the value from sheet INV cell L4 & then pasting it in customers row line on sheet DATABASE cell P
Rich (BB code):
Private Sub Print_Invoice_Click()
Dim sPath As String, strFileName As String
If Range("M11") = "" Then
MsgBox ("PLEASE SELECT A MODEL"), vbCritical, "VEHICLE TYPE WAS NOT SELECTED"
Range("M11").Select
Exit Sub
End If
If Range("L18") = "" Then
MsgBox ("PLEASE SELECT A PAYMENT TYPE "), vbCritical, "PAYMENT TYPE WAS NOT SELECTED"
Range("L18").Select
Exit Sub
End If
If Range("O14") = "" Then
MsgBox ("PLEASE ENTER THE BITING"), vbCritical, "NO BITING WAS ENTERED"
Range("O14").Select
Exit Sub
End If
If Range("O17") = "" Then
MsgBox ("PLEASE ENTER KEY TYPE"), vbCritical, "NO KEY TYPE WAS ENTERED"
Range("O17").Select
Exit Sub
End If
strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DR\DR COPY INVOICES\" & Range("L4").Value & ".pdf"
If Dir(strFileName) <> vbNullString Then
MsgBox "INVOICE " & Range("L4").Value & " WAS NOT SAVED AS IT ALLREADY EXISTS", vbCritical + vbOKOnly, "INVOICE NOT SAVED MESSAGE"
Exit Sub
End If
If Range("M11").Value = "BIKE" Then
Dim WB As Workbook, DestWB As Workbook
Dim ws As Worksheet, DestWS As Worksheet
Dim rng As Range, rngDest As Range
Dim ColArr As Variant, SCol As Variant, DCol As Variant
On Error Resume Next
Set DestWB = Application.Workbooks("MOTORCYCLES.xlsm")
If DestWB Is Nothing Then
Workbooks.Open fileName:="C:\Users\Ian\Desktop\REMOTES ETC\DR\EXCEL WORKSHEETS\MOTORCYCLES.xlsm"
Set DestWB = Application.Workbooks("MOTORCYCLES.xlsm")
End If
On Error GoTo 0
Set WB = ThisWorkbook
On Error Resume Next
Set ws = WB.Worksheets("INV")
On Error GoTo 0
If ws Is Nothing Then
MsgBox "Worksheet 'DATABASE' IS MISSING"
Exit Sub
End If
Set DestWS = DestWB.Worksheets("INVOICES")
ColArr = Array("G13:A", "L16:B", "L15:C", "O14:D", "O17:E", "L13:F", "L4:G")
Dim DestNextRow As Long
With DestWS
If IsEmpty(.Range("A" & 1)) Then
DestNextRow = 1
Else
DestNextRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End If
End With
Application.ScreenUpdating = False
For Each SCol In ColArr
DCol = Split(SCol, ":")(1)
SCol = Split(SCol, ":")(0)
Set rng = ws.Range(SCol)
Set rngDest = DestWS.Range(DCol & DestNextRow)
rng.Copy
rngDest.PasteSpecial PASTE:=xlPasteValues
rngDest.Borders.Weight = xlThin
rngDest.Font.Size = 16
rngDest.Font.Bold = True
rngDest.HorizontalAlignment = xlCenter
rngDest.Cells.Interior.ColorIndex = 6
rngDest.Cells.RowHeight = 25
Next SCol
Application.ScreenUpdating = True
With Sheets("INVOICES")
If .AutoFilterMode Then .AutoFilterMode = False
x = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A2:G" & x).Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes, DataOption1:=xlSortTextAsNumbers
ActiveWorkbook.Close savechanges:=True
End With
Else
End If
Workbooks("DR.xlsm").Sheets("INV").Range("G1").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, fileName:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
End With
ActiveWindow.SelectedSheets.PrintOut copies:=1
MsgBox "ONCE PRINTED CLICKING OK WILL" & vbNewLine & vbNewLine & "SAVE INVOICE " & Range("L4").Value & " CLEAR PAGE INFO & DELETE THE GENERATED PDF ", vbExclamation + vbOKOnly, "PRINT SAVE & CLEAR MESSAGE"
Dim MyFile As String
MyFile = "C:\Users\Ian\Desktop\REMOTES ETC\DR\DR SCREEN SHOT PDF\" & Range("G13").Value & ".pdf"
If Dir(MyFile) <> "" Then Kill MyFile
Dim i As Long, lRow As Long
Set ws = Application.Worksheets("DATABASE")
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 6 To lRow
If Trim(Range("G13").Value) = Trim(ws.Cells(i, 1).Value) Then
If ws.Cells(i, 16).Value = "" Then
ws.Cells(i, 16).Value = Range("L4").Value ' adding invoice number to INV sheet "P"
ActiveSheet.Hyperlinks.Add ws.Cells(i, 16), Address:="C:\Users\Ian\Desktop\REMOTES ETC\DR\DR COPY INVOICES\" & Range("L4").Value & ".pdf"
MsgBox "INVOICE " & ws.Cells(i, 16).Value & " WAS HYPERLINKED SUCCESSFULLY" & vbNewLine & vbNewLine & "GENERATED PDF WAS ALSO DELETED ", vbInformation, "HYPERLINK SUCCESSFULL MESSAGE"
Else
If MsgBox("COLUMN CELL P ISNT EMPTY " & ws.Cells(i, 16).Value & " IS ENTERED IN IT." & vbNewLine & "WOULD YOU LIKE TO CORRECT IT ?", vbCritical + vbYesNo, "COLUMN P NOT EMPTY MESSAGE") = vbYes Then
ws.Activate
ws.Cells(i, 16).Select
End If
Exit Sub
End If
End If
Next i
Range("G14:G18").ClearContents
Range("L14:L18").ClearContents
Range("G27:L36").ClearContents
Range("G46:G50").ClearContents
Range("M11").ClearContents
Range("L4").Value = Range("L4").Value + 1
Range("G13").ClearContents
Range("G13").Select
Call PasteIfFormulas_Click
ActiveWorkbook.Save
End Sub