Forum Discussion

VBANew's avatar
VBANew
Copper Contributor
Jan 19, 2021

Excel Crashes when running full module

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 ru...
excel
Macros and VBA
office 365
NikolinoDE's avatar
NikolinoDE
Platinum Contributor
Jan 19, 2021

VBANew 

 

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)

  • VBANew's avatar
    VBANew
    Copper Contributor
    Jan 20, 2021

    NikolinoDE 

    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.

     

     

     

     

Resources