I am wondering I have one module with 95%+ of the code for my macro in different subs. what is the cleanest way to do this? Each sub in its own module? also is it better to put all the code that is for just that sheet in a module attached to a sheet?
Or other ideas that may help? all my code is below.
I want to stream line this and prevent issues when excel crashes and the macro causes excel to lock up every time i try and open that file. Like it did recently. i had to try a couple things and finally left me in.
all my code and modules it is in is below.
Module 1 (Print Tax Cert to PDF) - use this for someone who is not using the macro to automate the tax cert, Does it the manual way.
Sub Print_Bill_and_Cert()
'Print to PDF
Sheets(Array("Tax Cert Bill", "Tax Cert Form 2022-2021")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="T:\2022_TAX_CERTS\" & Sheets("Tax Cert Bill").Range("B17").Value & " - " & Sheets("Tax Cert Bill").Range("B12").Value & Format(Date, " - mm-dd-yyyy"), _
OpenAfterPublish:=True, ignoreprintareas:=False
End Sub
Module 2(Deleted Superseded by Module 3)
Module 3 (Deleted Superseded by Module 4)
Module 4 (IE, OutLook, PrintScreen, Copy text above and paste value then paste code, Numlock 32 bit info, paste printscreen in email body, print pdf, maybe more)
' IE and Print Screen Code to Have before Running Macro
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Const VK_SNAPSHOT As Byte = 44
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_SHOWMAXIMIZED = 3
Private Const VK_LCONTROL As Long = &HA2
Private Const VK_V = &H56
Private Const KEYEVENTF_EXTENDEDKEY As Long = &H1
Private Const KEYEVENTF_KEYUP As Long = &H2
Private Const VK_NUMLOCK As Byte = &H90
Private Const NumLockScanCode As Byte = &H45
' Wait Code to wait in seconds
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
Sub Full_Code()
Copy_List_Row_D_E_Paste_Value_Paste_Code
Enter_Parcel_Requestor
Print_PDF
IE_Load_PrintScreen
EMail_Auto_Populate
Select_List_ChooseCell_SaveFile
NUM_On
End Sub
Sub Copy_List_Row_D_E_Paste_Value_Paste_Code()
Sheets("List").Select
With Workbooks("Automated 2022 Tax Certification Form.xlsm").Sheets("List") ' .Select
If IsEmpty(Range("D2").Offset(1, 0)) Then
Range("D2").Copy Range("D2").Offset(1, 0)
Else
Range("D2").End(xlDown).Copy Range("D2").End(xlDown).Offset(1, 0)
End If
End With
With Workbooks("Automated 2022 Tax Certification Form.xlsm").Sheets("List") ' .Select
If IsEmpty(Range("E2").Offset(1, 0)) Then
Range("E2").Copy Range("E2").Offset(1, 0)
Else
Range("E2").End(xlDown).Copy Range("E2").End(xlDown).Offset(1, 0)
End If
End With
'Removes formulas above the last line
Dim ALR As Long
Dim ALR2 As Range
With Workbooks("Automated 2022 Tax Certification Form.xlsm").Sheets("List") ' .Selec ' Sheets("List") ' Sheet name
ALR = .Range("D" & .Rows.Count).End(xlUp).Row ' Letter in " " is the row you want code to run
Range("D2:E" & ALR - 1).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Application.CutCopyMode = False
End Sub
Sub Enter_Parcel_Requestor()
Dim myValue As Variant
myValue = InputBox("Enter Properly Formated Parcel#", "Please")
'Step 1: Declare Your Variables.
Dim LastRow As Long
'Step 2: Capture the last used row number.
LastRow = Cells(Rows.Count, 3).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow, 3).Offset(1, 0).Value = myValue ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
Dim myValue2 As Variant
myValue2 = InputBox("Requesters Name. Don't Use & or '", "Please")
'Step 1: Declare Your Variables.
Dim LastRow2 As Long
'Step 2: Capture the last used row number.
LastRow2 = Cells(Rows.Count, 6).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow2, 6).Offset(1, 0).Value = myValue2 ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
Dim myValue3 As Variant
myValue3 = MsgBox("Did you recive payment? If yes click YES else just hit enter.", vbQuestion + vbYesNo + vbDefaultButton2, "Do you have check in Hand?") ' InputBox("Enter Check# if Paid Else Hit Enter", "Please", "Unpaid")
'Step 1: Declare Your Variables.
Dim LastRow3 As Long
'Step 2: Capture the last used row number.
If myValue3 = vbYes Then
LastRow3 = Cells(Rows.Count, 2).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow3, 2).Offset(1, 0).Value = "PAID" ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Cells(LastRow3, 1).Offset(1, 0).Value = "$30"
Else
LastRow3 = Cells(Rows.Count, 2).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow3, 2).Offset(1, 0).Value = "UNPAID" ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
' Cells(LastRow3, 1).Offset(1, 0).Value = "$0"
End If
Dim myValue4 As Variant
myValue4 = InputBox("Enter Date If Not Todays Date for Sent Date. Format 00/00/00", "Please", Format(Now(), "mm/dd/yy"))
'Step 1: Declare Your Variables.
Dim LastRow4 As Long
'Step 2: Capture the last used row number.
LastRow4 = Cells(Rows.Count, 8).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow4, 8).Offset(1, 0).Value = myValue4 ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
End Sub
Sub Print_PDF()
' Print to PDF
Sheets(Array("Tax Cert Bill", "Tax Cert Form 2022-2021")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="T:\2022_TAX_CERTS\" & Sheets("Tax Cert Bill").Range("B17").Value & " - " & Sheets("Tax Cert Bill").Range("B12").Value & Format(Date, " - mm-dd-yyyy"), _
OpenAfterPublish:=True, ignoreprintareas:=False
End Sub
Sub IE_Load_PrintScreen()
' IE and OutLook
Dim NorryLink As String
' Link to copy Print Screen
NorryLink = "Home - County of Northumberland" & Sheets("Tax Cert Bill").Range("B17").Value
Dim IE As Object
Dim hwnd As Long, IECaption As String
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Width = 624
IE.Height = 756
IE.Navigate NorryLink
Wait 10
DoEvents
' ~~> Take a snapshot
Call keybd_event(VK_SNAPSHOT, 1, 0, 0)
'Application.SendKeys "(%{1068})"
DoEvents
IE.Quit
Set IE = Nothing
End Sub
Sub EMail_Auto_Populate()
' Declare Variables
Dim EmailApp As Object
Dim EmailItem As Object
Dim myAttachments As Object
Dim mailAddress As String
Dim TaxCertPDF As String
Dim EMail As String
' E-Mail Subject Parcel - Requestor - Date.pdf
TaxCertPDF = "T:\2022_TAX_CERTS\" & Sheets("Tax Cert Bill").Range("B17").Value & " - " & Sheets("Tax Cert Bill").Range("B12").Value & Format(Date, " - mm-dd-yyyy") & ".pdf"
' Look for the mail address in the MailInfo worksheet
Dim FinalResult As Variant, Table_Range As Range, LookupValue As Range
Set Table_Range = Sheets("Requestor").Range("A:B")
Set LookupValue = Sheets("Tax Cert Bill").Range("B12")
On Error Resume Next
FinalResult = Application.WorksheetFunction.VLookup(LookupValue, Table_Range, 2, False)
On Error GoTo 0
' Paste
Set EmailApp = CreateObject("Outlook.application")
Set EmailItem = EmailApp.CreateItem(0)
Set myAttachments = EmailItem.Attachments
' Application.SendKeys "(%{1068})"
' DoEvents
' Specify Email Items and Add Attachment
With EmailItem
.To = FinalResult
.Subject = Sheets("Tax Cert Bill").Range("B17").Value
.Attachments.Add TaxCertPDF
.display
'.body
'<~~ This is required so we can send keys to it
Wait 2 '<~~ wait for 2 seconds for email to get displayed
SendKeys "^({v})", True '<~~ Paste
DoEvents '<~~ Waiting for paste to happen
'.send
End With
Set EmailItem = Nothing
Set EmailApp = Nothing
Set DataObj = Nothing
End Sub
Sub Select_List_ChooseCell_SaveFile()
Sheets("List").Select
' MsgBox "PDF has been successfully Saved in T:\2022_TAX_CERTS\Parcel# - Requester - Todays Date.pdf"
'Step 1: Declare Your Variables.
Dim LastRow5 As Long
'Step 2: Capture the last used row number.
LastRow5 = Cells(Rows.Count, 3).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow5, 3).Offset(1, 0).Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
' Range().Value = myValue
' Dim myValue As Variant
' myValue = InputBox("Enter Properly Formated Parcel#", "Please")
ActiveWorkbook.Save 'd = True
' MsgBox "done"
End Sub
Module 5 (64 Bit NumLock Code)- thanks to https://www.mrexcel.com/board/members/shknbk2.364025/ - @shknbk2
Private Declare PtrSafe Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
Private Const VK_NUMLOCK = &H90
Private Const KEYEVENTF_KEYUP = &H2
Declare PtrSafe Function GetKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer
Sub NUM_TOGGLE() 'Toggle NUM-Lock key state
keybd_event VK_NUMLOCK, 1, 0, 0
keybd_event VK_NUMLOCK, 1, KEYEVENTF_KEYUP, 0
End Sub
Sub NUM_Off() 'Turn NUM-Lock off
If (GetKeyState(vbKeyNumlock) = 1) Then
keybd_event VK_NUMLOCK, 1, 0, 0
keybd_event VK_NUMLOCK, 1, KEYEVENTF_KEYUP, 0
End If
End Sub
Sub NUM_On() 'Turn NUM-Lock on
If Not (GetKeyState(vbKeyNumlock) = 1) Then
keybd_event VK_NUMLOCK, 1, 0, 0
keybd_event VK_NUMLOCK, 1, KEYEVENTF_KEYUP, 0
End If
End Sub
Or other ideas that may help? all my code is below.
I want to stream line this and prevent issues when excel crashes and the macro causes excel to lock up every time i try and open that file. Like it did recently. i had to try a couple things and finally left me in.
all my code and modules it is in is below.
Module 1 (Print Tax Cert to PDF) - use this for someone who is not using the macro to automate the tax cert, Does it the manual way.
Sub Print_Bill_and_Cert()
'Print to PDF
Sheets(Array("Tax Cert Bill", "Tax Cert Form 2022-2021")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="T:\2022_TAX_CERTS\" & Sheets("Tax Cert Bill").Range("B17").Value & " - " & Sheets("Tax Cert Bill").Range("B12").Value & Format(Date, " - mm-dd-yyyy"), _
OpenAfterPublish:=True, ignoreprintareas:=False
End Sub
Module 2(Deleted Superseded by Module 3)
Module 3 (Deleted Superseded by Module 4)
Module 4 (IE, OutLook, PrintScreen, Copy text above and paste value then paste code, Numlock 32 bit info, paste printscreen in email body, print pdf, maybe more)
' IE and Print Screen Code to Have before Running Macro
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Const VK_SNAPSHOT As Byte = 44
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_SHOWMAXIMIZED = 3
Private Const VK_LCONTROL As Long = &HA2
Private Const VK_V = &H56
Private Const KEYEVENTF_EXTENDEDKEY As Long = &H1
Private Const KEYEVENTF_KEYUP As Long = &H2
Private Const VK_NUMLOCK As Byte = &H90
Private Const NumLockScanCode As Byte = &H45
' Wait Code to wait in seconds
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
Sub Full_Code()
Copy_List_Row_D_E_Paste_Value_Paste_Code
Enter_Parcel_Requestor
Print_PDF
IE_Load_PrintScreen
EMail_Auto_Populate
Select_List_ChooseCell_SaveFile
NUM_On
End Sub
Sub Copy_List_Row_D_E_Paste_Value_Paste_Code()
Sheets("List").Select
With Workbooks("Automated 2022 Tax Certification Form.xlsm").Sheets("List") ' .Select
If IsEmpty(Range("D2").Offset(1, 0)) Then
Range("D2").Copy Range("D2").Offset(1, 0)
Else
Range("D2").End(xlDown).Copy Range("D2").End(xlDown).Offset(1, 0)
End If
End With
With Workbooks("Automated 2022 Tax Certification Form.xlsm").Sheets("List") ' .Select
If IsEmpty(Range("E2").Offset(1, 0)) Then
Range("E2").Copy Range("E2").Offset(1, 0)
Else
Range("E2").End(xlDown).Copy Range("E2").End(xlDown).Offset(1, 0)
End If
End With
'Removes formulas above the last line
Dim ALR As Long
Dim ALR2 As Range
With Workbooks("Automated 2022 Tax Certification Form.xlsm").Sheets("List") ' .Selec ' Sheets("List") ' Sheet name
ALR = .Range("D" & .Rows.Count).End(xlUp).Row ' Letter in " " is the row you want code to run
Range("D2:E" & ALR - 1).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Application.CutCopyMode = False
End Sub
Sub Enter_Parcel_Requestor()
Dim myValue As Variant
myValue = InputBox("Enter Properly Formated Parcel#", "Please")
'Step 1: Declare Your Variables.
Dim LastRow As Long
'Step 2: Capture the last used row number.
LastRow = Cells(Rows.Count, 3).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow, 3).Offset(1, 0).Value = myValue ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
Dim myValue2 As Variant
myValue2 = InputBox("Requesters Name. Don't Use & or '", "Please")
'Step 1: Declare Your Variables.
Dim LastRow2 As Long
'Step 2: Capture the last used row number.
LastRow2 = Cells(Rows.Count, 6).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow2, 6).Offset(1, 0).Value = myValue2 ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
Dim myValue3 As Variant
myValue3 = MsgBox("Did you recive payment? If yes click YES else just hit enter.", vbQuestion + vbYesNo + vbDefaultButton2, "Do you have check in Hand?") ' InputBox("Enter Check# if Paid Else Hit Enter", "Please", "Unpaid")
'Step 1: Declare Your Variables.
Dim LastRow3 As Long
'Step 2: Capture the last used row number.
If myValue3 = vbYes Then
LastRow3 = Cells(Rows.Count, 2).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow3, 2).Offset(1, 0).Value = "PAID" ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Cells(LastRow3, 1).Offset(1, 0).Value = "$30"
Else
LastRow3 = Cells(Rows.Count, 2).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow3, 2).Offset(1, 0).Value = "UNPAID" ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
' Cells(LastRow3, 1).Offset(1, 0).Value = "$0"
End If
Dim myValue4 As Variant
myValue4 = InputBox("Enter Date If Not Todays Date for Sent Date. Format 00/00/00", "Please", Format(Now(), "mm/dd/yy"))
'Step 1: Declare Your Variables.
Dim LastRow4 As Long
'Step 2: Capture the last used row number.
LastRow4 = Cells(Rows.Count, 8).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow4, 8).Offset(1, 0).Value = myValue4 ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
End Sub
Sub Print_PDF()
' Print to PDF
Sheets(Array("Tax Cert Bill", "Tax Cert Form 2022-2021")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="T:\2022_TAX_CERTS\" & Sheets("Tax Cert Bill").Range("B17").Value & " - " & Sheets("Tax Cert Bill").Range("B12").Value & Format(Date, " - mm-dd-yyyy"), _
OpenAfterPublish:=True, ignoreprintareas:=False
End Sub
Sub IE_Load_PrintScreen()
' IE and OutLook
Dim NorryLink As String
' Link to copy Print Screen
NorryLink = "Home - County of Northumberland" & Sheets("Tax Cert Bill").Range("B17").Value
Dim IE As Object
Dim hwnd As Long, IECaption As String
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Width = 624
IE.Height = 756
IE.Navigate NorryLink
Wait 10
DoEvents
' ~~> Take a snapshot
Call keybd_event(VK_SNAPSHOT, 1, 0, 0)
'Application.SendKeys "(%{1068})"
DoEvents
IE.Quit
Set IE = Nothing
End Sub
Sub EMail_Auto_Populate()
' Declare Variables
Dim EmailApp As Object
Dim EmailItem As Object
Dim myAttachments As Object
Dim mailAddress As String
Dim TaxCertPDF As String
Dim EMail As String
' E-Mail Subject Parcel - Requestor - Date.pdf
TaxCertPDF = "T:\2022_TAX_CERTS\" & Sheets("Tax Cert Bill").Range("B17").Value & " - " & Sheets("Tax Cert Bill").Range("B12").Value & Format(Date, " - mm-dd-yyyy") & ".pdf"
' Look for the mail address in the MailInfo worksheet
Dim FinalResult As Variant, Table_Range As Range, LookupValue As Range
Set Table_Range = Sheets("Requestor").Range("A:B")
Set LookupValue = Sheets("Tax Cert Bill").Range("B12")
On Error Resume Next
FinalResult = Application.WorksheetFunction.VLookup(LookupValue, Table_Range, 2, False)
On Error GoTo 0
' Paste
Set EmailApp = CreateObject("Outlook.application")
Set EmailItem = EmailApp.CreateItem(0)
Set myAttachments = EmailItem.Attachments
' Application.SendKeys "(%{1068})"
' DoEvents
' Specify Email Items and Add Attachment
With EmailItem
.To = FinalResult
.Subject = Sheets("Tax Cert Bill").Range("B17").Value
.Attachments.Add TaxCertPDF
.display
'.body
'<~~ This is required so we can send keys to it
Wait 2 '<~~ wait for 2 seconds for email to get displayed
SendKeys "^({v})", True '<~~ Paste
DoEvents '<~~ Waiting for paste to happen
'.send
End With
Set EmailItem = Nothing
Set EmailApp = Nothing
Set DataObj = Nothing
End Sub
Sub Select_List_ChooseCell_SaveFile()
Sheets("List").Select
' MsgBox "PDF has been successfully Saved in T:\2022_TAX_CERTS\Parcel# - Requester - Todays Date.pdf"
'Step 1: Declare Your Variables.
Dim LastRow5 As Long
'Step 2: Capture the last used row number.
LastRow5 = Cells(Rows.Count, 3).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow5, 3).Offset(1, 0).Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
' Range().Value = myValue
' Dim myValue As Variant
' myValue = InputBox("Enter Properly Formated Parcel#", "Please")
ActiveWorkbook.Save 'd = True
' MsgBox "done"
End Sub
Module 5 (64 Bit NumLock Code)- thanks to https://www.mrexcel.com/board/members/shknbk2.364025/ - @shknbk2
Private Declare PtrSafe Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
Private Const VK_NUMLOCK = &H90
Private Const KEYEVENTF_KEYUP = &H2
Declare PtrSafe Function GetKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer
Sub NUM_TOGGLE() 'Toggle NUM-Lock key state
keybd_event VK_NUMLOCK, 1, 0, 0
keybd_event VK_NUMLOCK, 1, KEYEVENTF_KEYUP, 0
End Sub
Sub NUM_Off() 'Turn NUM-Lock off
If (GetKeyState(vbKeyNumlock) = 1) Then
keybd_event VK_NUMLOCK, 1, 0, 0
keybd_event VK_NUMLOCK, 1, KEYEVENTF_KEYUP, 0
End If
End Sub
Sub NUM_On() 'Turn NUM-Lock on
If Not (GetKeyState(vbKeyNumlock) = 1) Then
keybd_event VK_NUMLOCK, 1, 0, 0
keybd_event VK_NUMLOCK, 1, KEYEVENTF_KEYUP, 0
End If
End Sub
