Jan 19 2021 07:56 AM
Please excuse me if I don't get the terminology correct. I have a module that calls about 8 different subs. I have run these subs seperately in order to ensure that there are not bugs and when I run through them all in the correct sequence excel doesn't crash. When I run the module as a whole excel crashes and I have no idea why. There is no error message. Where do I begin?
Jan 19 2021 10:05 AM
I do not know whether I can provide you with an adequate proposal for a solution.
I know for sure if you insert a file (without sensitive data) with your request.
Or in your case, the file that is afflicted with this problem,
you will be much quicker to suggest a suitable solution.
At the same time it is much easier for someone who wants to help to understand the subject.
Knowing the Excel version and operating system would also be an advantage.
Thank you for your understanding and patience
Nikolino
I know I don't know anything (Socrates)
Jan 20 2021 02:12 AM
Option Explicit
Sub ProformatoInvCS_BCR()
Call TransformFieldTitlesPF
Call InputLoadPF
Call CopyInvoice_Rename_CPValuePF
Call Delete_Buttons
Call PDFActiveSheetInvPF
Call Send_PdfInvPF
Call ProformaTab
Call InvoiceListdata
Call clearInvoice
End Sub
Sub TransformFieldTitlesPF()
Activeworksheet.Unprotect
Range("C5").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "Proforma"
Range("D5").Select
Workbooks.Open FileName:="C:\Users\User\OneDrive - BCR Plumbers\BCR Plumbers\Receivables\Proforma Invoices (New).xlsx"
End Sub
Sub InputLoadPF()
Dim wb As Workbook
Set wb = Workbooks("Proforma Invoices (New).xlsx")
Dim PFNumber As String
PFNumber = InputBox("Type in Proforma Invoice Number", "Load Proforma", "PF ZZddmmyy00")
Dim YNAnswer1 As Integer
If Len(PFNumber) = 14 Then
YNAnswer1 = MsgBox("This Proforma Invoice Nr refers to a receivable" & vbCrLf & _
"and not a Cash Sale." & vbCrLf & _
"Try Again?", vbYesNo)
If YNAnswer1 = vbYes Then
Call InputLoadPF
End If
End If
Dim ws As Worksheet
Dim ShWrite As Worksheet
Dim YNAnswer2 As Integer
Set ShWrite = ThisWorkbook.Sheets(1)
For Each ws In wb.Worksheets
If ws.Name = PFNumber Then
ShWrite.Range("D5").Value = PFNumber
ShWrite.Range("D1").Value = wb.Sheets(PFNumber).Range("D1").Value
ShWrite.Range("B9").Value = wb.Sheets(PFNumber).Range("B9").Value
ShWrite.Range("A17:D37").Value = wb.Sheets(PFNumber).Range("A17:D37").Value
End If
Next ws
If ThisWorkbook.ActiveSheet.Range("D5") = "" Then
YNAnswer2 = MsgBox("The Proforma Invoice Number you entered is incorrect." & vbCrLf & _
"Try again?", vbYesNo)
If YNAnswer2 = vbYes Then
Call InputLoadPF
End If
End If
Workbooks.Open "C:\Users\User\OneDrive - BCR Plumbers\BCR Plumbers\Income&Expenses\Income&Expenses FY2021.xlsm"
Workbooks.Open "C:\Users\User\OneDrive - BCR Plumbers\BCR Plumbers\Receivables\Cash Sales (Invoices) (New).xlsx"
End Sub
Public Sub CopyInvoice_Rename_CPValuePF()
ThisWorkbook.Activate
Sheet6.Copy After:=Workbooks("Cash Sales (Invoices) (New).xlsx").Sheets(1)
Workbooks("Cash Sales (Invoices) (New).xlsx").Sheets(2).Activate
ActiveSheet.Unprotect
ActiveSheet.Name = ActiveSheet.Range("D4")
Range("D1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("D4").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("B10:B12").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("InvAMT").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
End Sub
Sub Delete_Buttons()
Range("Developer").Select
Selection.ClearContents
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 3", "Rounded Rectangle 6", _
"Rounded Rectangle 7", "Rounded Rectangle 10", "Rounded Rectangle 11", _
"Rounded Rectangle 2", "Rounded Rectangle 4", "Rounded Rectangle 5", _
"Rounded Rectangle 8", "Rounded Rectangle 9")).Select
Application.CutCopyMode = False
Selection.Cut
End Sub
Sub PDFActiveSheetInvPF()
Dim wsA As Worksheet
Dim Path As String
Dim myFile As Variant
Dim StrName As String
Dim StrPathFile As String
On Error GoTo errHandler
Set wsA = ActiveSheet
StrName = ActiveSheet.Name
Path = "C:\Users\User\OneDrive - BCR Plumbers\BCR Plumbers\Receivables\Invoices (Cash Sales) PDF\"
StrPathFile = Path & StrName
myFile = Application.GetSaveAsFilename _
(InitialFileName:=StrPathFile, FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
Sub Send_PdfInvPF()
Dim OlApp As Object
Dim NewMail As Object
Dim OutAccount As Object
Dim InvoiceNr, CustomerName, Property, Recipient, FileFullPath, FileName, FilePath, TheTitle, Strbody As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Recipient = Range("B12").Value
Property = Range("B10").Value
InvoiceNr = Range("D4").Value
CustomerName = Split(Range("B9"), " ")(0)
TheTitle = "Invoice (" & Property & " - " & InvoiceNr & ")"
Strbody = "Good Day " & CustomerName & "," & vbCrLf & vbCrLf _
& "Please see the Invoice attached for work done. Kindly pay the balance due & use " & InvoiceNr & " as your payment reference." & vbCrLf & vbCrLf _
& "Thanks for your support." & vbCrLf & vbCrLf _
& "Kind regards," & vbCrLf & vbCrLf _
& "Bruce Mizen" & vbCrLf _
& "BCR Plumbers"
' Temporary file path where pdf
' file will be saved before
' sending it in email by attaching it.
FilePath = "C:\Users\User\OneDrive - BCR Plumbers\BCR Plumbers\Receivables\Invoices (Cash Sales) PDF\"
FileName = Range("D4").Value & ".pdf"
'Complete path of the file where it is saved
FileFullPath = FilePath & FileName
'Now open a new mail
Set OlApp = CreateObject("Outlook.Application")
Set NewMail = OlApp.CreateItem(0)
Set OutAccount = OlApp.Session.Accounts.Item("bruce@bcrplumbers.co.za")
On Error Resume Next
With NewMail
Set .SendUsingAccount = OutAccount 'Use with Late Binding
.To = Recipient
.CC = ""
.BCC = ""
.Subject = TheTitle
.Body = Strbody
.Attachments.Add FileFullPath
.SendUsingAccount = OutAccount
.Display
End With
Set NewMail = Nothing
Set OlApp = Nothing
Set OutAccount = Nothing
ActiveSheet.Tab.Color = RGB(255, 255, 255)
ActiveSheet.Protect
ActiveWorkbook.Close savechanges:=True
End Sub
Public Sub ProformaTab()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks("Proforma Invoices (New).xlsx")
For Each ws In wb.Worksheets
If Range("D5").Value = ws.Name Then
ws.Tab.Color = RGB(255, 0, 0)
End If
Next
wb.Close savechanges:=True
End Sub
Public Sub InvoiceListdata()
Workbooks("Income&Expenses FY2021").Activate
Dim ShRead As Worksheet
Dim ShWrite As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set ShRead = wb.Worksheets("Invoice")
Set ShWrite = Worksheets("Invoice List")
Dim cell As Range
For Each cell In Range("Invoice_Nr")
If cell.Value = ShRead.Range("D5").Value Then
ShWrite.Cells(cell.Row, "A").Resize(1, 6).Value = Array(ShRead.Range("D1"), ShRead.Range("B9"), ShRead.Range("D4"), ShRead.Range("A8"), ShRead.Range("InvAMT"), ShRead.Range("B10"))
Debug.Print cell.Row
End If
Next cell
ActiveWorkbook.Close savechanges:=True
End Sub
Sub clearInvoice()
Workbooks("Cash Sale Document generator (New)").Activate
Worksheets("Invoice").Range("D1,C5,D5,B9").ClearContents
Range("Invoice_Body").ClearContents
Range("Invoice_Body").EntireRow.AutoFit
Dim Rowcount As Integer
Dim InsRowCount As Integer
Rowcount = Range("Invoice_Body").Rows.Count
InsRowCount = 24 - Rowcount
If Rowcount < 23 Then
Rows("24:" & 24 + InsRowCount - 1).EntireRow.Insert
Range("A23:C23").Select
Selection.AutoFill Destination:=Range("A23:C" & 24 + InsRowCount - 1), Type:=xlFillDefault
End If
Columns("F:G").Select
Selection.EntireColumn.Hidden = True
Range("D1").Select
End Sub
Thanks so much...
Excel crashed after the email was created.