Advice for slight alteration to existing working code

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,602
Office Version
  1. 2007
Platform
  1. Windows
I use a code which places a invoice number into a worksheet cell then prints the invoice.

Like This
On the invoice page i click the command button which opens another sheet & shows the user a form with the invoice number & command button
In this case Invoice 448, the user clicks the command button & 448 is the placed in the cell for that customer in question in column P
The code then continues to print.
This post is to get away with the user having to click the command button for putting the invoice number in the cell.

Here is a screenshott of that form.
EaseUS_2024_08_18_10_33_54.jpg
#

This is the code for that form.
VBA Code:
Private Sub TransferInvNumber_Click()
    
    ActiveCell.Value = TransferInvoiceNumber.TextBox1.Value
      Unload Me
      
    Const FILE_PATH As String = "C:\Users\Ian\Desktop\REMOTES ETC\DR\DR COPY INVOICES\"
    If ActiveCell.Column = Columns("P").Column Then
    If Dir(FILE_PATH & ActiveCell.Value & ".pdf") <> "" Then
      ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:=FILE_PATH & ActiveCell.Value & ".pdf"
    Else
      ActiveCell.Hyperlinks.Delete
      MsgBox (FILE_PATH & ActiveCell.Value & ".pdf" & vbNewLine & vbNewLine & "FILE IS NOT IN FOLDER SPECIFIED, PLEASE CHECK PATH IS CORRECT"), vbCritical
    End If
    Else
      MsgBox "PLEASE SELECT AN INVOICE NUMBER.", vbExclamation, "HYPERLINKING THE INVOICE NUMBER"
    End If

 

End Sub

This is the main code in use which also calls for the form above
Code:
Private Sub Print_Invoice_Click()
    Dim answer As Integer
    Dim rng As Range
    Dim Cell As Range
    Dim MyFile As String
    Dim findString As String
    Dim sPath As String, strFileName As String
    Dim srcWS As Worksheet, destWS As Worksheet
    Set srcWS = ActiveWorkbook.Worksheets("INV")
    Set destWS = ActiveWorkbook.Worksheets("DATABASE")
    
    If Range("G13") = "" Then
      MsgBox "NO NAME SELECTED IN THE CUSTOMER DETAILS SECTION", vbCritical, "NO CUSTOMER SELECTED MESSAGE"
      Range("G13").Select 'CHECKING IF CUSTOMER IS SELECTED
    Exit Sub
    End If
 
    If Range("L18") = "" Then
      MsgBox ("PLEASE SELECT A PAYMENT TYPE "), vbCritical, "PAYMENT TYPE WAS NOT SELECTED"
      Range("L18").Select 'CHECKING IF PAYMENT TYPE HAS BEEN SELECTED
    Exit Sub
    End If
    
    If Range("L18") = "TO BE ADVISED" Then
      MsgBox ("PLEASE SELECT A PAYMENT TYPE "), vbCritical, "PAYMENT TYPE WAS NOT SELECTED"
      Range("L18").Select 'CHECKING IF PAYMENT TYPE HAS BEEN SELECTED
    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" & vbNewLine & vbNewLine & "PLEASE CHECK FILE IN FOLDER THAT WILL NOW OPEN.", vbCritical + vbOKOnly, "INVOICE NOT SAVED MESSAGE"
      VBA.Shell "explorer.exe /select, " & "" & strFileName & "", vbNormalFocus 'DUPLICATE INVOICE FOUND
    Exit Sub
    End If
    
    strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DR\DR COPY INVOICES\" & Range("L4").Value & ".pdf"
    With ActiveSheet
      .ExportAsFixedFormat Type:=xlTypePDF, fileName:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
    End With 'CURRENT INVOICE IS NOW SAVED
    
    With Sheets("DATABASE")
      Worksheets("DATABASE").Activate
    End With
    
    Set rng = ActiveSheet.Columns("A:A")
      findString = Worksheets("INV").Range("G13").Value
    Set Cell = rng.Find(What:=findString, LookIn:=xlFormulas, _
      LookAt:=xlWhole, MatchCase:=False) ' CUSTOMER FOUND IN COLUMN A
    
    If Cell Is Nothing Then
      MsgBox "NO CUSTOMER WAS FOUND"
    Else
    With Sheets("DATABASE")
      Cell.Select
      ActiveCell.Offset(0, 15).Select ' CUSTOMERS CELL IN COLUMN P NOW SELECTED
    End With
    End If
    
    If Len(ActiveCell.Value) <> 0 Then
      ValueInInvoiceCell.Show 'MESSAGE SHOWN IF CUSTOMERS INVOICE CELL IN COLUMN P HAS A VALUE IN IT

    Exit Sub
    Else
      TransferInvoiceNumber.Show 'NOW ENTER INVOICE NUMBER IN CUSTOMERS CELL IN COLUMN P & NOW HYPERLINKED
    End If
    
    With Sheets("INV")
      Worksheets("INV").Activate
    End With
      
     ActiveWindow.SelectedSheets.PrintOut copies:=1 'INVOICE NOW PRINTED
      answer = MsgBox("INVOICE HAS NOW BEEN SAVED" & vbNewLine & vbNewLine & "DID THE INVOICE PRINT OK FOR YOU ?", vbInformation + vbYesNo, "INVOICE PRINT OK MESSAGE")
 
    If answer = vbNo Then
      ActiveWindow.SelectedSheets.PrintOut copies:=1 'INVOICE PRINTED AGAIN IF FIRST PRINT WAS POOR
    End If

      Range("L4").Value = Range("L4").Value + 1
      Range("G27:L36").ClearContents
      Range("G46:G50").ClearContents
      Range("G13").ClearContents
      Range("G13").Select
      ActiveWorkbook.Save

    End Sub

All above works fine just trying if possible to not have the user click the command button to to invoice number in cell.
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
So as per post above im trying to get away with manually clicking the button shown TRANSFER INV NUMBER TO DATABASE.
The code on that button is shown below.
The line of code in Red ive just added thinking it will work but the code runs BUT the actual inv number doesnt get placed into the cell.

If the user clicks the button then the inv number 448 is entered in the cell,with the code below the cell stays empty.

Can you advise what im doing wrong Thanks.



Rich (BB code):
Private Sub TransferInvNumber_Click()
    
    ActiveCell.Value = TransferInvoiceNumber.TextBox1.Value
      Unload Me
      
    Const FILE_PATH As String = "C:\Users\Ian\Desktop\REMOTES ETC\DR\DR COPY INVOICES\"
    If ActiveCell.Column = Columns("P").Column Then
    If Dir(FILE_PATH & ActiveCell.Value & ".pdf") <> "" Then
      ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:=FILE_PATH & ActiveCell.Value & ".pdf"
    Else
      ActiveCell.Hyperlinks.Delete
      MsgBox (FILE_PATH & ActiveCell.Value & ".pdf" & vbNewLine & vbNewLine & "FILE IS NOT IN FOLDER SPECIFIED, PLEASE CHECK PATH IS CORRECT"), vbCritical
    End If
    Else
      MsgBox "PLEASE SELECT AN INVOICE NUMBER.", vbExclamation, "HYPERLINKING THE INVOICE NUMBER"
    End If

 Application.Run "TransferInvNumber_Click"

End Sub
 
Upvote 0

Forum statistics

Threads
1,221,310
Messages
6,159,176
Members
451,543
Latest member
cesymcox

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