5
\$\begingroup\$

I started learning VBA for an internship, 3 months ago. This is the last project I have worked on. It does all the tasks it has to do, it's all about code review. I will be grateful for all suggestions for optimization of solutions/other solutions, good practices (writing, commenting on the code) and everything else that you think may help me in the future.

The workbook is used to automate the sending of an e-mail by the applicant to the classifier (appropriate people in the company who can complete the process), and then for the classifier it automates the filling of a special excel sheet with which further steps are taken. Additionally, this workbook is on a network drive. Target users download it to their local drive and may sometimes need to be updated, hence the "check workbook update" function (this function caused me a lot of problems, I'm curious about other solutions. I'm aware that the current one is not the best). The list of classifiers is also monitored for changes because it also changes regularly

Everywhere in the code where "xyz" is intentional. the program was written in Polish and I actually translate it only for the needs of this post, so I am sorry if somewhere there are remains of Polish and places not the best translations

Code in "Backend" worksheet

        Option Explicit
        Dim externalFile As Workbook
        Dim backend As Worksheet

        Const numberOfRowsBeforeRecords = 1

        Sub CheckingComplianceClassifierList()
        'Checking if the workbook with the list of classifiers has not changed since the last time using this workbook and update this list in this workbook if needed
        Module3.OptimizeCodeBegin

        Dim lastModifiedExternalFile As Date 'last updated classifier workbook
        Dim cellWithModifiedDate As Range

        Dim externalFilePath As String

        Set backend = ThisWorkbook.Worksheets("Backend")
        externalFilePath = backend.Range("B2").Value2

        Set externalFile = Module3.OpenAndSetFile(externalFilePath)

        If Not externalFile Is Nothing Then 'case when the OpenAndSetFile function does not work (probably, the wrong path)

            lastModifiedExternalFile = FileDateTime(externalFilePath)

            Set cellWithModifiedDate = backend.Range("B1")

            If cellWithModifiedDate.Value2 < lastModifiedExternalFile Then 'last check < modification date
                Dim classifiersAmount As Integer

                With externalFile.Worksheets(1)
                    classifiersAmount = .Cells(.Rows.Count, "A").End(xlUp).Row - numberOfRowsBeforeRecords 'checks the amount of classifiers in an external file
                End With

                PrepareWorksheet classifiersAmount 'Cleaning classifier tables
                RewriteClassifiers classifiersAmount
                ProcessClose 'removes filters, closes the external file
                cellWithModifiedDate.Value2 = Now() 'updates date
            Else
                externalFile.Close False
            End If
        End If

        Module3.OptimizeCodeEnd
        End Sub

        Sub PrepareWorksheet(classifiersAmount As Integer)

        'clearing the classifier tables - needed if the number in some area decreases

        With backend
            If .Range("A7") <> "" Then .ListObjects("TabelaMechanical").DataBodyRange.Delete 'if cell A7 (first table cell) is empty, it means that the table is already cleared
            If .Range("B7") <> "" Then .ListObjects("TabelaPower").DataBodyRange.Delete
            If .Range("C7") <> "" Then .ListObjects("TabelaInteriors").DataBodyRange.Delete
            If .Range("D7") <> "" Then .ListObjects("TabelaCSS").DataBodyRange.Delete
        End With

        End Sub

        Sub RewriteClassifiers(classifiersAmount As Integer)
        'Sub which takes data from the external spreadsheet and pastes it into it
        Dim externalData As Worksheet
        Dim namesColumn As Range

        Dim lastRow As Integer
        lastRow = classifiersAmount + numberOfRowsBeforeRecords

        Set externalData = externalFile.Worksheets(1)
        Set namesColumn = externalData.Range("C2:C" & lastRow) 'column containing the name of classifiers

        FilterAndCopy "Mechanical Systems", externalData, namesColumn, "A7" 'Sub FilterAndCopy(workingArea As String, externalData As Worksheet, namesColumn As Range, destination As String)
        FilterAndCopy "Power&Control", externalData, namesColumn, "B7"
        FilterAndCopy "Interiors", externalData, namesColumn, "C7"
        FilterAndCopy "CSS", externalData, namesColumn, "D7"

        End Sub

        Sub ProcessClose()

        externalFile.Worksheets(1).Cells.AutoFilter
        externalFile.Close SaveChanges:=False

        End Sub

        Sub FilterAndCopy(workingArea As String, externalData As Worksheet, namesColumn As Range, destination As String)

        externalData.Cells.AutoFilter Field:=11, Criteria1:=workingArea

        namesColumn.SpecialCells(xlCellTypeVisible).Copy 'copies visible cells from the column containing the name of the classifier
        backend.Range(destination).PasteSpecial xlPasteValues

        End Sub

        Sub CheckingComplianceTemplate()
        Set backend = ThisWorkbook.Worksheets("Backend")

        Dim lastModifiedExternalFile As Date

        Dim externalFilePath As String
        externalFilePath = backend.Range("E2").Value2
        lastModifiedExternalFile = FileDateTime(externalFilePath)

        Dim cellWithModifiedDate As Range
        Set cellWithModifiedDate = backend.Range("E1")

        Dim permissionCell As Range
        Set permissionCell = backend.Range("E3")

        If cellWithModifiedDate.Value2 < lastModifiedExternalFile Then 'last check < modification date, a positive result means that the template has been modified since the last check
            permissionCell.Value2 = False
            MsgBox "Your version of the spreadsheet is out of date. Download current template - location: xyz"
        Else
            permissionCell.Value2 = True
            cellWithModifiedDate = Now()
        End If
        End Sub

Code in "ThisWorkbook"

    Option Explicit

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ThisWorkbook.Worksheets("backend").CheckingComplianceTemplate

    If ThisWorkbook.Worksheets("backend").Range("E3").Value2 = True Then
        ThisWorkbook.Worksheets("backend").Range("E1").Value2 = DateAdd("s", 10, Now())
    End If

    Module3.OptimizeCodeEnd
    End Sub

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    ThisWorkbook.Worksheets("backend").CheckingComplianceTemplate

    If ThisWorkbook.Worksheets("backend").Range("E3").Value2 = True Then
        ThisWorkbook.Worksheets("backend").Range("E1").Value2 = DateAdd("s", 10, Now())
    End If
    End Sub

    Private Sub Workbook_Open()
    With ThisWorkbook
        .Worksheets(2).Protect UserInterfaceOnly:=True, Password:="xyz"
        .Worksheets(3).Protect UserInterfaceOnly:=True, Password:="xyz"
    End With

    Arkusz4.CheckingComplianceClassifierList
    Arkusz4.CheckingComplianceTemplate
    End Sub

Code in "Module2" module

    Option Explicit
    Dim batchLoad As Workbook
    Dim classifications As Worksheet, backend As Worksheet
    Dim recordAmount As Integer
    Const numberRowsBeforeRecordsClassificationWorksheet = 8

    Sub BatchLoadFillingProcess()

    ThisWorkbook.Worksheets("backend").CheckingComplianceTemplate
    If ThisWorkbook.Worksheets("backend").Range("E3") = True Then 'cell E3 stores the value true / false set on the basis of checking compliance with the template on a network drive
        Module3.OptimizeCodeBegin

        PrepareWorksheet 'assign/calculate global variables/objects
        If CheckSignature = True Then 'compares the saved signature with what it should be
            If Verification = True Then 'Verification whether all started rows have all columns filled in and whether part of the classifier is filled in correctly
                FillingBatchLoad
                SaveBatchLoad
            Else
                batchLoad.Close SaveChanges:=False  'close BatchLoada's template
            End If
            Module3.OptimizeCodeEnd
        Else
            batchLoad.Close SaveChanges:=False  'close BatchLoada's template
        End If
    End If

    End Sub

    Sub PrepareWorksheet()

    Set classifications = ThisWorkbook.Worksheets("Classification")
    Set backend = ThisWorkbook.Worksheets("backend")

    Dim templatePath As String
    templatePath = backend.Range("H1")

    Workbooks.Open Filename:=templatePath, ReadOnly:=True
    Set batchLoad = ActiveWorkbook

    Dim recordRange As Range
    Set recordRange = ThisWorkbook.Worksheets(1).Range("B9:B59")
    recordAmount = Application.WorksheetFunction.CountA(recordRange)

    End Sub

    Function CheckSignature() As Boolean
    Dim currentSignature As String, project As String, classifier As String, correctSignature As String

    currentSignature = backend.Range("B5").Value2

    project = classifications.Range("F3").Value2
    classifier = classifications.Range("F5").Value2
    classifier = Replace(classifier, " ", "")

    correctSignature = project & classifier & recordAmount

    If correctSignature = currentSignature Then
        CheckSignature = True
    Else
        CheckSignature = False
        MsgBox "Wrong Signature"
    End If

    End Function

    Function Verification() As Boolean
    Dim recordAmount As Integer

    Verification = VerificationRowFilling 'function checks if columns B to H are filled in every started row

    If Verification = True Then
        Verification = ClassifierRowVerification 'function checks if the classifier did not fill rows that the applicant did not fill
    End If

    End Function

    Function VerificationRowFilling() As Boolean

    'Define the range of filled rows
        Dim rangeFilledRows As Range
        Set rangeFilledRows = Range(classifications.Cells(numberRowsBeforeRecordsClassificationWorksheet + 1, 2), classifications.Cells(numberRowsBeforeRecordsClassificationWorksheet + recordAmount, 8))

    'The condition checks whether the number of filled cells in the range (left side) corresponds to the number of cells in the range (right side)
    'there is no option to fill more cells than it is in range, so else is synonymous with equality
        If WorksheetFunction.CountA(rangeFilledRows) < rangeFilledRows.Count Then
            VerificationRowFilling = False
            MsgBox "Not all columns in the started rows are filled"
        Else
            VerificationRowFilling = True
        End If

    End Function

    Function ClassifierRowVerification() As Boolean

    'define the range that we will check
        Dim amountRowsFilledByApplicant As Integer
        amountRowsFilledByApplicant = numberRowsBeforeRecordsClassificationWorksheet + recordAmount

        Dim rangeOutOfFilledRange As Range
        Set rangeOutOfFilledRange = Range(classifications.Cells(amountRowsFilledByApplicant + 1, 2), classifications.Cells(60, 8))
        'Note: 60th row is out of table, but if the last row was 59, the condition check below gives an incorrect result if all rows in the table are filled (amountRowsFilledByApplicant + 1 = 59 + 1 = 60)

    'checking if there are any filled cells in the unwanted range
        Dim amountOfFilledCellsInUnwantedRange As Integer
        amountOfFilledCellsInUnwantedRange = Application.WorksheetFunction.CountA(rangeOutOfFilledRange)

    'return the appropriate flag, display the message
        If amountOfFilledCellsInUnwantedRange = 0 Then 'no filled cells outside the wanted range
            ClassifierRowVerification = True
        Else
            ClassifierRowVerification = False
            MsgBox "filling cells outside records filled by the applicant"
        End If

    End Function

    Sub FillingBatchLoad()
    'Function that fulfills the BatchLoad template based on the data entered in this spreadsheet

        Dim currentSpreadsheetRow As Range, currentBatchLoadRow As Range
        Dim loopCounter As Integer
        Const naglowekBatchLoada = 1

        For loopCounter = 1 To recordAmount
            'defining the row from which we take data and to which we save data in a given iteration
            With classifications
                Set currentSpreadsheetRow = .Range(.Cells(loopCounter + numberRowsBeforeRecordsClassificationWorksheet, 2), .Cells(loopCounter + numberRowsBeforeRecordsClassificationWorksheet, 8))
            End With
            With batchLoad.Worksheets(1)
                Set currentBatchLoadRow = .Range(.Cells(loopCounter + naglowekBatchLoada, 1), .Cells(loopCounter + naglowekBatchLoada, 31))
            End With

            currentBatchLoadRow(1).Value2 = currentSpreadsheetRow(1).Value2     'xyz
            currentBatchLoadRow(2).Value2 = currentSpreadsheetRow(4).Value2     'xyz
            currentBatchLoadRow(3).Value2 = currentSpreadsheetRow(2).Value2     'xyz
            currentBatchLoadRow(4).Value2 = "?"                                 'xyz
            currentBatchLoadRow(5).Value2 = "?"                                 'xyz
            currentBatchLoadRow(6).Value2 = "?"                                 'xyz
            currentBatchLoadRow(7).Value2 = "?"                                 'xyz
            currentBatchLoadRow(8).Value2 = currentSpreadsheetRow(5).Value2     'xyz
            currentBatchLoadRow(13).Value2 = classifications.Range("F3").Value2 'xyz
            currentBatchLoadRow(14).Value2 = backend.Range("B4").Value2         'xyz
            currentBatchLoadRow(16).Value2 = "?"                                'xyz
            currentBatchLoadRow(17).Value2 = "?"                                'xyz
            currentBatchLoadRow(18).Value2 = currentSpreadsheetRow(6).Value2    'xyz
            currentBatchLoadRow(20).Value2 = currentSpreadsheetRow(7).Value2    'xyz
            currentBatchLoadRow(21).Value2 = "?"                                'xyz
            currentBatchLoadRow(23).Value2 = backend.Range("B3").Value2         'xyz
            currentBatchLoadRow(24).Value2 = "?"                                'xyz
            currentBatchLoadRow(25).Value2 = classifications.Range("F4").Value2 'xyz
        Next loopCounter
    End Sub

    Sub SaveBatchLoad()

        Dim tytul As String
        tytul = "BatchLoad for project - " & classifications.Range("F3").Value2 'classifications.Range("F3") it's project's number

        batchLoad.Activate
        Dim batchLoadPath As String
        batchLoadPath = Application.GetSaveAsFilename(InitialFileName:=tytul, FileFilter:="Excel Files (*.xlsb), *.xlsb")

        If batchLoadPath <> "False" Then 'batchLoadPath = False means that the user has not selected any location
            batchLoad.SaveAs Filename:=batchLoadPath
            batchLoad.Close SaveChanges:=False  'close BatchLoad's template
            Workbooks.Open Filename:=batchLoadPath
        Else
            MsgBox "Please enter the path"
            batchLoad.Close SaveChanges:=False
        End If

    End Sub

Code in "Module3" module

    Option Explicit
    Dim CalcState As Long
    Dim EventState As Boolean, PageBreakState As Boolean, DisplayAlertsState As Boolean

    Sub OptimizeCodeBegin()

    Application.ScreenUpdating = False

    'EventState = Application.EnableEvents
    'Application.EnableEvents = False

    CalcState = Application.Calculation
    Application.Calculation = xlCalculationManual

    PageBreakState = ActiveSheet.DisplayPageBreaks
    ActiveSheet.DisplayPageBreaks = False

    DisplayAlertsState = Application.DisplayAlerts
    Application.DisplayAlerts = False

    End Sub

    Sub OptimizeCodeEnd()

    ActiveSheet.DisplayPageBreaks = PageBreakState
    Application.Calculation = CalcState
    'Application.EnableEvents = EventState
    Application.DisplayAlerts = DisplayAlertsState
    Application.ScreenUpdating = True

    End Sub


    Sub CalculateRunTime_Seconds()
    'PURPOSE: Determine how many seconds it took for code to completely run
    'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

    Dim StartTime As Double
    Dim SecondsElapsed As Double

    'Remember time when macro starts
      StartTime = Timer

    '*****************************
    'Insert Your Code Here...
    '*****************************

    'Determine how many seconds code took to run
      SecondsElapsed = Round(Timer - StartTime, 2)

    'Notify user in seconds
      MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

    End Sub

    Function OpenAndSetFile(path) As Workbook

        If Dir(path) = "" Then 'dir(path) returns the file name, "" means that no file was found
            MsgBox "file path not found"
            Exit Function
        Else
            Set OpenAndSetFile = Workbooks.Open(Filename:=path, ReadOnly:=True)
        End If

    End Function

    Sub Cleaning()

    Dim orderRange As Range, applicantRange As Range, classifierRange As Range

    If MsgBox("Do you want to clear the spreadsheet from the entered data??", vbYesNo, "Cleaning") = vbYes Then

        With ThisWorkbook.Worksheets("Classification")
            Set orderRange = .Range("F3:F5")
            Set applicantRange = .Range("B9:F59")
            Set classifierRange = .Range("G9:H59")
        End With

        orderRange.ClearContents
        applicantRange.ClearContents
        classifierRange.ClearContents

    End If
    End Sub

Code in "Module4" module

Option Explicit
Dim amountRecords As Integer

Const numberRowsBeforeRecordsClassificationWorksheet = 8

Sub SendingEmailToClassifier()

ThisWorkbook.Worksheets("backend").CheckingComplianceTemplate
If ThisWorkbook.Worksheets("backend").Range("E3") = True Then 'cell E3 stores the value true / false set on the basis of checking compliance with the template on a network drive
    Module3.OptimizeCodeBegin

    If Verification = True Then
        PrepareWorksheet 'finding classifier and applicant email
        SendingEmail 'preparation, content generation and sending an e-mail
    Else
        ThisWorkbook.Worksheets("Backend").Range("B3:B4").ClearContents
    End If
    Module3.OptimizeCodeEnd
End If

End Sub

Sub PrepareWorksheet()

ThisWorkbook.Worksheets("Backend").Range("B3").Value2 = ClassiferEmail
ThisWorkbook.Worksheets("Backend").Range("B4").Value2 = ApplicantEmail

End Sub

Function Verification() As Boolean

Dim CollumnInTabel As Range

Set CollumnInTabel = ThisWorkbook.Worksheets("Classification").Range("B9:B59") 'first of the columns inside the table
amountRecords = Application.WorksheetFunction.CountA(CollumnInTabel)

If amountRecords > 0 Then 'A positive result means that at least one record has been entered
    Verification = VerificationNoBlankRows 'check if there are no empty lines between the entered records
Else
    MsgBox "Enter at least one record"
    Exit Function
End If

If Verification = True Then
    Verification = VerificationRowFilling 'checking if every started record has columns A-F filled
Else
    Exit Function
End If

If Verification = True Then
    Verification = VerificationClassifierEmpty() 'checking if the classifier area is empty
Else
    Exit Function
End If

If Verification = True Then
    Verification = VerificationOrderRange 'checking if order range is filled
Else
    Exit Function
End If

End Function

Function VerificationOrderRange() As Boolean
'' Check if the cells F3-F5 are filled and return the appropriate message, if needed
VerificationOrderRange = True

    With ThisWorkbook.Worksheets("Classification")
        If .Range("F3") = "" Then
            MsgBox "Cell F3 (Project number) is empty"
            VerificationOrderRange = False
            Exit Function
        End If

        If .Range("F4") = "" Then
            MsgBox "Cell F4 (Working area) is empty"
            VerificationOrderRange = False
            Exit Function
        End If

        If .Range("F5") = "" Then
            MsgBox "Cell F5 (Classifier) is empty"
            VerificationOrderRange = False
            Exit Function
        End If
    End With

End Function

Function VerificationNoBlankRows() As Boolean
'verification function which checks if there are no gaps between the entered records
'records should be entered one by one if there is a row after the row, which is the sum of the number of entered records and the number of rows before the records, there is a blank row somewhere

'define the range that we will check
    Dim CorrectFilledRows As Integer
    CorrectFilledRows = amountRecords + numberRowsBeforeRecordsClassificationWorksheet


    With ThisWorkbook.Worksheets("Classification")
        Dim rangeOutOfFilledRange As Range
        Set rangeOutOfFilledRange = .Range(.Cells(CorrectFilledRows + 1, 2), .Cells(60, 6))
        'Note: 60th row is out of table, but if the last row was 59, the condition check below gives an incorrect result if all rows in the table are filled (amountRowsFilledByApplicant + 1 = 59 + 1 = 60)
    End With

'checking if there are any filled cells
    Dim amountOfFilledCellsInUnwantedRange As Integer
    amountOfFilledCellsInUnwantedRange = Application.WorksheetFunction.CountA(rangeOutOfFilledRange)

'return the appropriate flag, display the message
    If amountOfFilledCellsInUnwantedRange = 0 Then
        VerificationNoBlankRows = True
    Else
        VerificationNoBlankRows = False
        MsgBox "Empty lines between entered records"
    End If

End Function

Function VerificationRowFilling() As Boolean

    With ThisWorkbook.Worksheets("Classification")
        Dim rangeOfFilledRange As Range
        Set rangeOfFilledRange = .Range(.Cells(numberRowsBeforeRecordsClassificationWorksheet + 1, 2), .Cells(numberRowsBeforeRecordsClassificationWorksheet + amountRecords, 6))
    End With

'The condition checks whether the number of filled cells in the range (left side) corresponds to the number of cells in the range (right side)
'there is no option to fill more cells than it is in range, so else is synonymous with equality
    If WorksheetFunction.CountA(rangeOfFilledRange) < rangeOfFilledRange.Count Then
        VerificationRowFilling = False
        MsgBox "Not all columns in the started records are filled"
    Else
        VerificationRowFilling = True
    End If

End Function

Function VerificationClassifierEmpty() As Boolean

    With ThisWorkbook.Worksheets("Classification")
        Dim classifierRange As Range
        Set classifierRange = .Range("G9:H59")
    End With

    If WorksheetFunction.CountA(classifierRange) = 0 Then 'no filled cells in the given range (part of the table for the classifier)
        VerificationClassifierEmpty = True
    Else
        VerificationClassifierEmpty = False
        MsgBox "Classifier range should be empty"
    End If

End Function

Sub SendingEmail()
Dim OutApp As Object, Outmail As Object

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.logon
Set Outmail = OutApp.CreateItem(0)

On Error Resume Next
    'fill out email
    With Outmail
        .To = ThisWorkbook.Worksheets("Backend").Range("B3").Value2 & "test"
        .Subject = GenerateEmailSubject

        .Display
        .HTMLBody = GenerateEmailContent & .HTMLBody 'function generating the content of the e-mail (text, table preview) and adding a footer

        SaveSignature 'save the signature which will be used in filling BatchLoad

        ThisWorkbook.Save 'save the file so that after adding it as an attachment to the e-mail there would be all the data entered (records and signature)
        .Attachments.Add ThisWorkbook.FullName
    End With
    On Error GoTo 0
    Set Outmail = Nothing
    Set OutApp = Nothing

End Sub

Function GenerateEmailSubject() As String

Dim text As String
text = "Adding classification to the project - "
GenerateEmailSubject = text & ThisWorkbook.Worksheets("Classification").Range("F3").Value2

End Function

Function GenerateEmailContent() As String
'defining range of data to be copied to the e-mail
    Dim tableRange As Range
    Dim textRange As String

    textRange = "A1:F" & numberRowsBeforeRecordsClassificationWorksheet + amountRecords + 1
    Set tableRange = ThisWorkbook.Worksheets("Classification").Range(textRange)

'email content
    Dim head As String, body As String

    'before tabel
    head = "<HTML><BODY>Hello"
    body = "<BR />I need to classify these parts for our project"

    'tabel from excel
    body = body & RangetoHTML(tableRange)

    'after tabel
    body = body & "<BR />Thank you!"

    GenerateEmailContent = head & body

End Function

Function ApplicantEmail() As String
    Dim text As String

    Dim olApp As Object
    Set olApp = CreateObject("outlook.application")
    text = olApp.Session.CurrentUser.Name 'example: "Surname, Name             xyz xyz xyz - xyz xyz"

    Dim commaAfterSurname As Integer, spaceAfterName As Integer

    commaAfterSurname = InStr(1, text, ",")
    spaceAfterName = InStr(commaAfterSurname + 2, text, " ")

    Dim Name As String, Surname As String
    Surname = Left(text, commaAfterSurname - 1)
    Name = Mid(text, commaAfterSurname + 2, spaceAfterName - commaAfterSurname - 2)

    ApplicantEmail = UCase(Name) & "." & UCase(Surname) & "@domain.com"
End Function

Function ClassiferEmail() As String
'prepare
    Dim path As String
    path = ThisWorkbook.Worksheets("Backend").Range("B2").Value2

    Dim externalFile As Workbook
    Set externalFile = Module3.OpenAndSetFile(path)

    Dim classifier As String
    classifier = ThisWorkbook.Worksheets("Classification").Range("F5").Value2

    Dim classifiersAmount As Integer
    Const numberRowsBeforeRecordsClassifierWorkBook = 1

    With externalFile.Worksheets(2)
       classifiersAmount = .Cells(.Rows.Count, "A").End(xlUp).Row - numberRowsBeforeRecordsClassifierWorkBook
    End With

'finding classifier email
    externalFile.Worksheets(2).Cells.AutoFilter

    externalFile.Worksheets(2).Range("C1:D" & classifiersAmount + 1).AutoFilter Field:=3, Criteria1:=classifier
    ClassiferEmail = externalFile.Worksheets(2).Range("D2:D" & classifiersAmount + 1).SpecialCells(xlCellTypeVisible)

    externalFile.Close SaveChanges:=False
End Function

Function RangetoHTML(rng As Range)
'donwloaded from: https://www.reddit.com/r/excel/comments/37ppo4/how_to_copy_excel_cells_into_a_outlook_email/
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    ' Copy the range and create a workbook to receive the data.
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    ' Publish the sheet to an .htm file.
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    ' Read all data from the .htm file into the RangetoHTML subroutine.
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    ' Close TempWB.
    TempWB.Close SaveChanges:=False

    ' Delete the htm file.
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Sub SaveSignature()

Dim project As String, mail As String, signature As String

project = ThisWorkbook.Worksheets("Classification").Range("F3").Value2    'Range("F3") is Project number
mail = ThisWorkbook.Worksheets("backend").Range("B3").Value2    'Range("B3") is classifier email

Dim atPosition As Integer
atPosition = InStr(1, mail, "@")  'Search @ in the email adress
mail = Left(mail, atPosition - 1)
mail = Replace(mail, ".", "")

signature = project & mail & amountRecords 'np gfdNAMESURNAME28
ThisWorkbook.Worksheets("backend").Range("B5").Value2 = signature
End Sub

Classification worksheet

Backend worksheet

\$\endgroup\$
0

2 Answers 2

2
\$\begingroup\$

I am not going to go through all of the code - instead I'll give you some basic information. This is not meant to be an answer, just more typing than a comment will allow.

  1. Name your modules.

  2. Use better indentation. Even though whitespace is ignored, that doesnt mean you shouldn't have tidier looking code as well.

  3. Since you're new to VBA I'll explain an important concept. Learning to work in memory is very important. Having to interact with the application's "objects" will significantly slow down your code. For example, you do lots of sheet manipulation in module4 and module2 - does this actuall need to occur? or is it OCD? Or could it be done all at once? Just some things to think about. When possilbe, learn to use arrays where you can. This leads to the next point...

  4. OptimizeCodeBegin and OptimizeCodeEnd - its good that your jamming things into functions and subs. You'll eventaully start building your own personal library of functions and classes. You may even have seperate files that you will use as a class/library repository that you can reference from other projects. However, these two specifically point out an issue in your code. In Excel's object model, these properties that youre turning off/on are a symptom of poor performing code. Using these often a tell tale sign of the need to do a code rewrite. Another big issue with them is that if your code bombs and they dont get turned back on, you have to restart excel to get back to proper funcitonality. Which leads me to the next point:

  5. Error handling - where is it?

  6. Learn what late binding is. Its a common interview question to test your knowledge but more importantly late binding is helpful when you do not know whether or not there will be version differences of excel (especially if youre distributing documents). This isnt relevant to your code per say, but its something you need to know how to use and understand when/why you would need to use it.

\$\endgroup\$
6
  • \$\begingroup\$ "This is not meant to be an answer," That's not really a statement to encourage this. \$\endgroup\$ Nov 29, 2019 at 19:23
  • 1
    \$\begingroup\$ There's absolutely answer/review material in this post. Upvoted! \$\endgroup\$ Nov 29, 2019 at 19:43
  • 2
    \$\begingroup\$ For every sub/function you write, you need to be in the habit of the first things you type/copy&paste is your error handling code - strong disagree though: it's critical to handle errors at entry points... but most procedures should bubble up errors they can't handle (so the caller gets to handle it). Systematically handling errors is harmful IMO. \$\endgroup\$ Nov 29, 2019 at 19:46
  • \$\begingroup\$ @MathieuGuindon Fair and I agree - I was mostly tailoring this answer for someone who is newer. The point being that lacking error handling in this particular instance could lead to "why is my excel not responding." Ive seen too many times where the topic as a whole is ignored. \$\endgroup\$
    – Doug Coats
    Nov 29, 2019 at 20:04
  • 2
    \$\begingroup\$ About late binding: any member call made against Object or Variant is late bound. Late binding is much more than member calls against objects defined in a library that isn't referenced - implicit late binding is literally everywhere, and very very much relevant to OP's code. For example anything chained to Worksheets(...) is late-bound, because Sheets.Item (Worksheets property is a Sheets collection object with an Item default member) returns an Object. \$\endgroup\$ Nov 29, 2019 at 20:13
2
\$\begingroup\$

Excellent first post. The code is well laid out. It is obvious that you are very meticulous and it shows in your coding style.

Worksheet Code Names

Set backend = ThisWorkbook.Worksheets("Backend") was used 3 times in code and ThisWorkbook.Worksheets("Backend") was used a total of 20 times. Whenever possible change the code-name of your worksheets to something meaningful. Changing worksheets code name creates a fully qualified reference which is unaffected by having its tab name changed and is visible to intellisense.

Use Named Ranges

Worksheets("Backend").Range("B3") is referred to in 3 separate methods. If you move the ClassiferEmail location you will have to make sure that you find every reference or your code will break.

ThisWorkbook.Worksheets("Backend").Range("B3").Value2 = ClassiferEmail

Naming your ranges will allow you to change the layout of your worksheets without breaking your code. Named ranges should be qualified to their parent worksheets. To simplify the referencing I will add a property to the worksheet with the same name as the range (see code below).

Sub PrepareWorksheet()

    ThisWorkbook.Worksheets("Backend").Range("B3").Value2 = ClassiferEmail
    ThisWorkbook.Worksheets("Backend").Range("B4").Value2 = ApplicantEmail

End Sub

At first glance, I thought ClassiferEmail and ApplicantEmail were class level variable. It turns out that they are single use functions that set the worksheet value. The worksheet values are, however, referenced several times. It would be make more sense to give those names to the ranges and change the functions to subs (e.g. SetClassiferEmail and SetApplicantEmail).

Clearing ListObjects

This is very situational:

If .Range("A7") <> "" Then .ListObjects("TabelaMechanical").DataBodyRange.Delete

This is the right way:

If Not .ListObjects("TabelaMechanical").DataBodyRange Is Nothing Then .ListObjects("TabelaMechanical").DataBodyRange.Delete

I also add properties to my worksheets to refer to the ListObjects on it.

Miscellaneous

The externalFile is read-only, why both turning off AutoFilter?

Sub ProcessClose()

    externalFile.Worksheets(1).Cells.AutoFilter
    externalFile.Close SaveChanges:=False

End Sub

I prefer to keep the external files open while I am coding. THe line below is also useful in cases where the end user has is working on the external file.

If externalFile.ReadOnly Then externalFile.Close SaveChanges:=False

Only visible rows of filtered data are copied. There is no need to use SpecialCells(xlCellTypeVisible) when copying filtered data.

namesColumn.SpecialCells(xlCellTypeVisible).Copy

I like the use of the constants Const numberOfRowsBeforeRecords = 1 bit using it in conjunction with "C2" defeats the purpose. Mainly

BackEnd Worksheet Code Refactored

Const numberOfRowsBeforeRecords = 1

Sub CheckingComplianceClassifierList()

    'Checking if the workbook with the list of classifiers has not changed since the last time using this workbook and update this list in this workbook if needed
    Module3.OptimizeCodeBegin

    Dim externalFile As Workbook
    Set externalFile = Module3.OpenAndSetFile(Me.ExternalFilePathCell.Value)

    If Not externalFile Is Nothing Then 'case when the OpenAndSetFile function does not work (probably, the wrong path)
        Dim lastModifiedExternalFile As Date 'last updated classifier workbook
        lastModifiedExternalFile = FileDateTime(Me.ExternalFilePathCell.Value)

        If Me.ModifiedDateCell.Value2 < lastModifiedExternalFile Then 'last check < modification date

            Dim classifiersAmount As Long

            With externalFile.Worksheets(1)
                classifiersAmount = .Cells(.Rows.Count, "A").End(xlUp).Row - numberOfRowsBeforeRecords 'checks the amount of classifiers in an external file
            End With

            PrepareWorksheet 'Cleaning classifier tables
            RewriteClassifiers externalFile, classifiersAmount
            Me.ModifiedDateCell.Value2 = Now() 'updates date
        End If

        If externalFile.ReadOnly Then externalFile.Close SaveChanges:=False
    End If

    Module3.OptimizeCodeEnd
End Sub

Sub RewriteClassifiers(ByRef externalFile As Workbook, ByVal classifiersAmount As Long)
    'Sub which takes data from the external spreadsheet and pastes it into it

    Dim lastRow As Integer
    lastRow = classifiersAmount + numberOfRowsBeforeRecords

    Dim externalData As Worksheet
    Set externalData = externalFile.Worksheets(1)

    Dim namesColumn As Range
    Set namesColumn = externalData.Range("C2").Resize(classifiersAmount) 'column containing the name of classifiers

    FilterAndCopy "Mechanical Systems", externalData, namesColumn, Me.TabelaMechanical 'Sub FilterAndCopy(workingArea As String, externalData As Worksheet, namesColumn As Range, destination As String)
    FilterAndCopy "Power&Control", externalData, namesColumn, Me.TabelaPower
    FilterAndCopy "Interiors", externalData, namesColumn, Me.TabelaInteriors
    FilterAndCopy "CSS", externalData, namesColumn, Me.TabelaCSS

End Sub

Sub FilterAndCopy(workingArea As String, externalData As Worksheet, namesColumn As Range, table As ListObject)
    externalData.Cells.AutoFilter Field:=11, Criteria1:=workingArea
    namesColumn.Copy 'copies visible cells from the column containing the name of the classifier

    If Not table.DataBodyRange Is Nothing Then table.DataBodyRange.Delete
    table.Range.Offset(1).PasteSpecial xlPasteValues
End Sub

Sub CheckingComplianceTemplate()
    If Me.ModifiedDateCell.Value2 < FileDateTime(Me.ExternalFilePathCell.Value) Then 'last check < modification date, a positive result means that the template has been modified since the last check
        Me.PermissionCell.Value2 = False
        MsgBox "Your version of the spreadsheet is out of date. Download current template - location: xyz"
    Else
        Me.PermissionCell.Value2 = True
        Me.ModifiedDateCell.Value2 = Now()
    End If
End Sub

Public Property Get TabelaMechanical() As ListObject
    Set TabelaMechanical = Me.ListObjects("TabelaMechanical")
End Property

Public Property Get TabelaPower() As ListObject
    Set TabelaPower = Me.ListObjects("TabelaPower")
End Property

Public Property Get TabelaInteriors() As ListObject
    Set TabelaInteriors = Me.ListObjects("TabelaInteriors")
End Property

Public Property Get TabelaCSS() As ListObject
    Set TabelaCSS = Me.ListObjects("TabelaCSS")
End Property

Public Property Get ApplicantEmailCell() As Range
    Set ApplicantEmailCell = Me.Range("ApplicantEmail")
End Property

Public Property Get ClassiferEmailCell() As Range
    Set ClassiferEmailCell = Me.Range("ClassiferEmail")
End Property

Public Property Get PermissionCell() As Range
    Set PermissionCell = Me.Range("PermissionCell")
End Property

Public Property Get ModifiedDateCell() As Range
    Set ModifiedDateCell = Me.Range("ModifiedDate")
End Property

Public Property Get ExternalFilePathCell() As Range
    Set ExternalFilePathCell = Me.Range("ExternalFilePath")
End Property

FillingBatchLoad

Again I like the use of constants but numberRowsBeforeRecordsClassificationWorksheet is 46 characters.
loopCounter is also too long for my taste. Using a single letter for the counter name will suffice when there is only one loop. There isn't really even a need for the loop.

I would have refactored this sub but the range rely on the code below taken from a separate sub. There are much better ways to define ranges.

Set recordRange = ThisWorkbook.Worksheets(1).Range("B9:B59")
recordAmount = Application.WorksheetFunction.CountA(recordRange)
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.