I have this codes on this modules on my excel file

Module: SetupModule
vba
Option Explicit

Const SHEET_NAME_MAIN As String = "Sheet1"
Const SHEET_NAME_LOG As String = "ActivityLog"
Const SHEET_NAME_FOLLOW_UP As String = "FollowUpMessages"
Const SHEET_NAME_PREFERENCES As String = "Preferences"
Const BTN_CAPTION_ADD As String = "Add to List"
Const BTN_CAPTION_DELETE As String = "Delete"
Const BTN_CAPTION_SEND_FOLLOW_UP As String = "Send Follow-Up"
Const BTN_CAPTION_CHECK_RESPONSES As String = "Check Responses"
Const BACKUP_INTERVAL_HOURS As Integer = 1
Const DEFAULT_BACKUP_PATH As String = "C:\Backups\"

Sub InitializeFullEmailTracker()
    On Error GoTo ErrorHandler
    
    Dim wsMain As Worksheet, wsLog As Worksheet, wsFollowUp As Worksheet, wsPreferences As Worksheet
    Set wsMain = EnsureSheetExists(SHEET_NAME_MAIN)
    Set wsLog = EnsureSheetExists(SHEET_NAME_LOG)
    Set wsFollowUp = EnsureSheetExists(SHEET_NAME_FOLLOW_UP)
    Set wsPreferences = EnsureSheetExists(SHEET_NAME_PREFERENCES)

    SetupHeaders wsMain
    SetupInputFields wsMain
    SetupButtons wsMain
    SetupActivityLog wsLog
    SetupFollowUpMessages wsFollowUp
    SetupPreferences wsPreferences

    MsgBox "Email Tracker Initialized. You're ready to go!", vbInformation
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbExclamation
    Debug.Print "Error in InitializeFullEmailTracker: " & Err.Description
    Resume Next
End Sub

Sub EnsureSheetExists(sheetName As String) As Worksheet
    Dim ws As Worksheet
    On Error GoTo ErrorHandler
    Set ws = ThisWorkbook.Sheets(sheetName)
    If ws Is Nothing Then
        Set ws = ThisWorkbook.Sheets.Add
        ws.Name = sheetName
    End If
    On Error GoTo 0
    Set EnsureSheetExists = ws
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred while creating sheet: " & sheetName & " - " & Err.Description, vbExclamation
    Debug.Print "Error in EnsureSheetExists: " & sheetName & " - " & Err.Description
    Resume Next
End Sub

Sub SetupHeaders(ws As Worksheet)
    On Error GoTo ErrorHandler
    With ws
        .Cells(1, 1).Value = "Email Subject"
        .Cells(1, 2).Value = "Recipients"
        .Cells(1, 3).Value = "Status"
        .Cells(1, 4).Value = "Remarks"
        .Cells(1, 6).Value = "Delete" ' Delete button column in column F
        .Cells(1, 7).Value = "Send Follow-Up" ' Send Follow-Up button column in column G
        .Cells(1, 8).Value = "Check Responses" ' Check Responses button column in column H
    End With
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred while setting up headers: " & Err.Description, vbExclamation
    Debug.Print "Error in SetupHeaders: " & Err.Description
    Resume Next
End Sub

Sub SetupInputFields(ws As Worksheet)
    On Error GoTo ErrorHandler
    With ws
        .Cells(2, 1).Value = "Input Subject Here"
        .Cells(2, 2).Value = "Input Recipients Here"
    End With
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred while setting up input fields: " & Err.Description, vbExclamation
    Debug.Print "Error in SetupInputFields: " & Err.Description
    Resume Next
End Sub

Sub SetupButtons(ws As Worksheet)
    On Error GoTo ErrorHandler
    Dim btn As Button
    If Not ButtonExists(ws, BTN_CAPTION_ADD) Then
        Set btn = ws.Buttons.Add(450, 10, 100, 20) ' Adjust position as needed
        With btn
            .Caption = BTN_CAPTION_ADD
            .OnAction = "AddEmailToList"
        End With
    End If
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred while setting up buttons: " & Err.Description, vbExclamation
    Debug.Print "Error in SetupButtons: " & Err.Description
    Resume Next
End Sub

Sub SetupActivityLog(wsLog As Worksheet)
    On Error GoTo ErrorHandler
    With wsLog
        .Cells(1, 1).Value = "Date"
        .Cells(1, 2).Value = "Action"
    End With
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred while setting up activity log: " & Err.Description, vbExclamation
    Debug.Print "Error in SetupActivityLog: " & Err.Description
    Resume Next
End Sub

Sub SetupFollowUpMessages(wsFollowUp As Worksheet)
    On Error GoTo ErrorHandler
    With wsFollowUp
        .Cells(1, 1).Value = "Type"
        .Cells(1, 2).Value = "Message"
        .Cells(2, 1).Value = "Daily Follow-Up"
        .Cells(3, 1).Value = "Escalation"
        .Cells(2, 2).Value = "This is a daily follow-up. Please let us know if you need any further information."
        .Cells(3, 2).Value = "We have not received a response. This is an escalation email. Please respond at your earliest convenience."
    End With
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred while setting up follow-up messages: " & Err.Description, vbExclamation
    Debug.Print "Error in SetupFollowUpMessages: " & Err.Description
    Resume Next
End Sub

Sub SetupPreferences(wsPreferences As Worksheet)
    On Error GoTo ErrorHandler
    With wsPreferences
        .Cells(1, 1).Value = "Backup Path"
        .Cells(1, 2).Value = DEFAULT_BACKUP_PATH
        .Cells(2, 1).Value = "Backup Interval (Hours)"
        .Cells(2, 2).Value = BACKUP_INTERVAL_HOURS
    End With
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred while setting up preferences: " & Err.Description, vbExclamation
    Debug.Print "Error in SetupPreferences: " & Err.Description
    Resume Next
End Sub

Function ButtonExists(ws As Worksheet, caption As String) As Boolean
    Dim btn As Button
    ButtonExists = False
    For Each btn In ws.Buttons
        If btn.Caption = caption Then
            ButtonExists = True
            Exit For
        End If
    Next btn
End Function
Module: UtilityModule
vba
Option Explicit

Sub AddEmailToList()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(SHEET_NAME_MAIN)
    
    Dim subject As String, recipients As String
    subject = Trim(ws.Cells(2, 1).Value)
    recipients = Trim(ws.Cells(2, 2).Value)
    
    If ValidateInput(subject, recipients) Then
        Dim nextRow As Long
        nextRow = GetNextAvailableRow(ws)
        
        AddEmailEntry ws, nextRow, subject, recipients
        LogAction "Added email: " & subject
        
        ClearInputFields ws
    End If
End Sub

Sub AddEmailEntry(ws As Worksheet, row As Long, subject As String, recipients As String)
    Dim emailList As String
    emailList = ExtractEmails(recipients)
    
    With ws
        .Hyperlinks.Add Anchor:=.Cells(row, 1), Address:="", _
                        SubAddress:="'Sheet1'!A" & row, _
                        TextToDisplay:=subject, _
                        ScreenTip:="Click to search conversation in Outlook"
        
        .Cells(row, 1).ClearComments
        .Cells(row, 1).AddComment subject
        .Cells(row, 1).Comment.Visible = False
        
        .Cells(row, 2).Value = emailList
        .Cells(row, 3).Value = "Followed Up"
        .Cells(row, 4).Value = "Awaiting Response"
        
        AddDeleteButton ws, row
        AddSendFollowUpButton ws, row
        AddCheckResponsesButton ws, row
    End With
End Sub

Sub AddDeleteButton(ws As Worksheet, row As Long)
    Dim btnLeft As Double, btnTop As Double
    btnLeft = ws.Cells(row, 6).Left
    btnTop = ws.Cells(row, 6).Top
    
    Dim btn As Button
    Set btn = ws.Buttons.Add(btnLeft, btnTop, 80, 20)
    With btn
        .Caption = BTN_CAPTION_DELETE
        .OnAction = "DeleteRow"
    End With
End Sub

Sub AddSendFollowUpButton(ws As Worksheet, row As Long)
    Dim btnLeft As Double, btnTop As Double
    btnLeft = ws.Cells(row, 7).Left
    btnTop = ws.Cells(row, 7).Top
    
    Dim btn As Button
    Set btn = ws.Buttons.Add(btnLeft, btnTop, 100, 20)
    With btn
        .Caption = BTN_CAPTION_SEND_FOLLOW_UP
        .OnAction = "SendFollowUp"
    End With
End Sub

Sub AddCheckResponsesButton(ws As Worksheet, row As Long)
    Dim btnLeft As Double, btnTop As Double
    btnLeft = ws.Cells(row, 8).Left
    btnTop = ws.Cells(row, 8).Top
    
    Dim btn As Button
    Set btn = ws.Buttons.Add(btnLeft, btnTop, 100, 20)
    With btn
        .Caption = BTN_CAPTION_CHECK_RESPONSES
        .OnAction = "CheckEmailResponses"
    End With
End Sub

Sub DeleteRow()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(SHEET_NAME_MAIN)
    
    Dim btn As Button
    On Error GoTo ErrHandler
    Set btn = ws.Buttons(Application.Caller)
    
    Dim deleteRow As Long
    deleteRow = btn.TopLeftCell.Row
    
    ws.Rows(deleteRow).Delete
    btn.Delete
    
    LogAction "Deleted email entry from row " & deleteRow
    
    Exit Sub
    
ErrHandler:
    MsgBox "Error deleting row. Please try again.", vbCritical
    Debug.Print "Error in DeleteRow: " & Err.Description
    Resume Next
End Sub

Sub ClearInputFields(ws As Worksheet)
    With ws
        .Cells(2, 1).Value = "Input Subject Here"
        .Cells(2, 2).Value = "Input Recipients Here"
    End With
End Sub

Sub LogAction(action As String)
    Dim wsLog As Worksheet
    Set wsLog = ThisWorkbook.Sheets(SHEET_NAME_LOG)
    
    Dim nextLogRow As Long
    nextLogRow = GetNextAvailableRow(wsLog)
    
    With wsLog
        .Cells(nextLogRow, 1).Value = Now
        .Cells(nextLogRow, 2).Value = action
    End With
End Sub

Function GetNextAvailableRow(ws As Worksheet) As Long
    GetNextAvailableRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
    If GetNextAvailableRow < 3 Then GetNextAvailableRow = 3
End Function

Function ExtractEmails(recipientStr As String) As String
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "\b[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\.[A-Z|a-z]{2,7}\b"
    regex.Global = True
    
    Dim matches As Object, emailList As String
    Set matches = regex.Execute(recipientStr)
    
    For Each match In matches
        emailList = emailList & match.Value & "; "
    Next match
    
    If Len(emailList) > 2 Then
        ExtractEmails = Left(emailList, Len(emailList) - 2)
    Else
        ExtractEmails = ""
    End If
End Function

Sub SearchOutlookConversations(subject As String)
    Dim olApp As Object, olNamespace As Object, olFolder As Object, olExplorer As Object
    Dim searchText As String, olSearchScopeAllFolders As Integer
    
    olSearchScopeAllFolders = 2
    searchText = "subject:""" & subject & """"
    
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    
    If olApp Is Nothing Then
        MsgBox "Outlook is not installed or could not be started.", vbCritical
        Exit Sub
    End If
    
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(6) ' 6 = olFolderInbox
    
    Set olExplorer = olApp.Explorers.Add(olFolder, 0)
    olExplorer.Display
    olExplorer.Search searchText, olSearchScopeAllFolders
    
    If Not olExplorer Is Nothing Then
        olExplorer.Activate
    Else
        MsgBox "Please ensure Outlook is properly set up.", vbExclamation
    End If
End Sub

Sub HyperlinkClicked(Target As Hyperlink)
    Dim ws As Worksheet, subject As String
    Set ws = ThisWorkbook.Sheets(SHEET_NAME_MAIN)
    
    If Not Target.Range.Comment Is Nothing Then
        subject = Target.Range.Comment.Text
    Else
        MsgBox "No subject found!", vbExclamation
        Exit Sub
    End If
    
    Call SearchOutlookConversations(subject)
End Sub

Sub AutoBackup()
    Dim backupPath As String
    On Error GoTo ErrorHandler
    backupPath = GetBackupPath & "Backup_" & Format(Now, "yyyy_mm_dd_hh_mm_ss") & ".xlsm"
    
    Application.DisplayAlerts = False
    ThisWorkbook.SaveCopyAs backupPath
    Application.DisplayAlerts = True
    
    LogAction "Backup saved to: " & backupPath
    Call AutoBackupScheduler
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred while creating backup: " & Err.Description, vbExclamation
    Debug.Print "Error in AutoBackup: " & Err.Description
    Resume Next
End Sub

Sub AutoBackupScheduler()
    Dim interval As Integer
    On Error GoTo ErrorHandler
    interval = GetBackupInterval
    
    On Error Resume Next
    Application.OnTime Now + TimeValue(interval & ":00:00"), "AutoBackup"
    On Error GoTo 0
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred while scheduling backup: " & Err.Description, vbExclamation
    Debug.Print "Error in AutoBackupScheduler: " & Err.Description
    Resume Next
End Sub

Sub FollowUpEscalation()
    Dim ws As Worksheet, wsFollowUp As Worksheet
    Set ws = ThisWorkbook.Sheets(SHEET_NAME_MAIN)
    Set wsFollowUp = ThisWorkbook.Sheets(SHEET_NAME_FOLLOW_UP)
    
    Dim lastRow As Long, followUpMessage As String, escalationMessage As String
    lastRow = GetLastDataRow(ws)
    
    followUpMessage = wsFollowUp.Cells(2, 2).Value
    escalationMessage = wsFollowUp.Cells(3, 2).Value
    
    Dim i As Long
    For i = 3 To lastRow
        If ws.Cells(i, 3).Value = "Followed Up" And ws.Cells(i, 4).Value = "Awaiting Response" Then
            Dim subject As String, recipients As String
            subject = ws.Cells(i, 1).Value
            recipients = ws.Cells(i, 2).Value
            
            Dim daysSinceFollowUp As Integer
            daysSinceFollowUp = DateDiff("d", CDate(ws.Cells(i, 5).Value), Now)
            
            If daysSinceFollowUp >= 10 Then
                SendEmail recipients, subject, escalationMessage
                ws.Cells(i, 3).Value = "Escalated"
                ws.Cells(i, 4).Value = "Awaiting Response"
                LogAction "Escalated email: " & subject
            ElseIf daysSinceFollowUp >= 1 Then
                SendEmail recipients, subject, followUpMessage
                ws.Cells(i, 5).Value = Now
                LogAction "Sent follow-up for email: " & subject
            End If
        End If
    Next i
End Sub

Sub CheckEmailResponses()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(SHEET_NAME_MAIN)
    
    Dim lastRow As Long
    lastRow = GetLastDataRow(ws)
    
    Dim i As Long
    For i = 3 To lastRow
        If ws.Cells(i, 3).Value = "Followed Up" And ws.Cells(i, 4).Value = "Awaiting Response" Then
            Dim subject As String, recipients As String
            subject = ws.Cells(i, 1).Value
            recipients = ws.Cells(i, 2).Value
            
            If CheckForResponse(subject) Then
                ws.Cells(i, 3).Value = "Responded"
                ws.Cells(i, 4).Value = "Response Received"
                LogAction "Response received for email: " & subject
            End If
        End If
    Next i
End Sub

Function ValidateInput(subject As String, recipients As String) As Boolean
    If subject = "" Or recipients = "" Then
        MsgBox "Please enter both subject and recipients!", vbExclamation
        ValidateInput = False
    Else
        ValidateInput = True
    End If
End Function

Function GetBackupPath() As String
    Dim wsPreferences As Worksheet
    On Error GoTo ErrorHandler
    Set wsPreferences = ThisWorkbook.Sheets(SHEET_NAME_PREFERENCES)
    
    GetBackupPath = wsPreferences.Cells(1, 2).Value
    Exit Function

ErrorHandler:
    MsgBox "An error occurred while getting backup path: " & Err.Description, vbExclamation
    Debug.Print "Error in GetBackupPath: " & Err.Description
    GetBackupPath = DEFAULT_BACKUP_PATH
    Resume Next
End Function

Function GetBackupInterval() As Integer
    Dim wsPreferences As Worksheet
    On Error GoTo ErrorHandler
    Set wsPreferences = ThisWorkbook.Sheets(SHEET_NAME_PREFERENCES)
    
    GetBackupInterval = wsPreferences.Cells(2, 2).Value
    Exit Function

ErrorHandler:
    MsgBox "An error occurred while getting backup interval: " & Err.Description, vbExclamation
    Debug.Print "Error in GetBackupInterval: " & Err.Description
    GetBackupInterval = BACKUP_INTERVAL_HOURS
    Resume Next
End Function

Function GetLastDataRow(ws As Worksheet) As Long
    GetLastDataRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
End Function

Sub SendEmail(recipients As String, subject As String, body As String)
    Dim olApp As Object, olMail As Object
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    
    If olApp Is Nothing Then
        MsgBox "Outlook is not installed or could not be started.", vbCritical
        Exit Sub
    End If
    
    Set olMail = olApp.CreateItem(0) ' 0 = olMailItem
    With olMail
        .To = recipients
        .Subject = subject
        .Body = body
        .Send
    End With
    
    Set olMail = Nothing
    Set olApp = Nothing
End Sub

Function CheckForResponse(subject As String) As Boolean
    Dim olApp As Object, olNamespace As Object, olFolder As Object, olItems As Object, olItem As Object
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    
    If olApp Is Nothing Then
        MsgBox "Outlook is not installed or could not be started.", vbCritical
        Exit Function
    End If
    
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(6) ' 6 = olFolderInbox
    Set olItems = olFolder.Items.Restrict("[Subject] = '" & subject & "'")
    
    CheckForResponse = False
    For Each olItem In olItems
        If olItem.ReceivedTime >= DateAdd("d", -10, Now) Then
            CheckForResponse = True
            Exit For
        End If
    Next olItem
    
    Set olItem = Nothing
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
End Function
Module: DataVisualizationModule
vba
Option Explicit

Sub CreateDataVisualization()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(SHEET_NAME_MAIN)
    
    Dim chartSheet As Worksheet
    On Error Resume Next
    Set chartSheet = ThisWorkbook.Sheets("Charts")
    If chartSheet Is Nothing Then
        Set chartSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        chartSheet.Name = "Charts"
    End If
    On Error GoTo 0
    
    CreateStatusChart chartSheet, ws
    CreateResponseChart chartSheet, ws
End Sub

Sub CreateStatusChart(chartSheet As Worksheet, ws As Worksheet)
    Dim lastRow As Long
    lastRow = GetLastDataRow(ws)
    
    Dim chartRange As Range
    Set chartRange = ws.Range("A2:A" & lastRow)
    
    Dim chart As Chart
    Set chart = chartSheet.Shapes.AddChart2(251, xlColumnClustered).Chart
    With chart
        .SetSourceData Source:=chartRange
        .HasTitle = True
        .ChartTitle.Text = "Email Status Distribution"
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Name = "Status"
        .SeriesCollection(1).Values = ws.Range("C3:C" & lastRow)
        .SeriesCollection(1).XValues = ws.Range("A3:A" & lastRow)
    End With
End Sub

Sub CreateResponseChart(chartSheet As Worksheet, ws As Worksheet)
    Dim lastRow As Long
    lastRow = GetLastDataRow(ws)
    
    Dim chartRange As Range
    Set chartRange = ws.Range("A2:A" & lastRow)
    
    Dim chart As Chart
    Set chart = chartSheet.Shapes.AddChart2(251, xlPie).Chart
    With chart
        .SetSourceData Source:=chartRange
        .HasTitle = True
        .ChartTitle.Text = "Response Status Distribution"
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Name = "Response"
        .SeriesCollection(1).Values = ws.Range("D3:D" & lastRow)
        .SeriesCollection(1).XValues = ws.Range("A3:A" & lastRow)
    End With
End Sub
Module: ImportExportModule
vba
Option Explicit

Sub ExportData()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(SHEET_NAME_MAIN)
    
    Dim saveFileDialog As FileDialog
    Set saveFileDialog = Application.FileDialog(msoFileDialogSaveAs)
    With saveFileDialog
        .Title = "Save As CSV"
        .InitialFileName = "EmailTracker_" & Format(Now, "yyyy_mm_dd_hh_mm_ss") & ".csv"
        .FilterIndex = 2
        .Filters.Add "CSV Files", "*.csv", 1
        .Filters.Add "All Files", "*.*", 2
        If .Show = -1 Then
            ws.Copy
            ActiveWorkbook.SaveAs Filename:=.SelectedItems(1), FileFormat:=xlCSV
            ActiveWorkbook.Close SaveChanges:=False
            MsgBox "Data exported successfully!", vbInformation
        End If
    End With
End Sub

Sub ImportData()
    Dim openFileDialog As FileDialog
    Set openFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    With openFileDialog
        .Title = "Import CSV"
        .InitialFileName = ""
        .FilterIndex = 1
        .Filters.Add "CSV Files", "*.csv", 1
        .Filters.Add "All Files", "*.*", 2
        If .Show = -1 Then
            Dim importFilePath As String
            importFilePath = .SelectedItems(1)
            
            Dim importWs As Worksheet
            Set importWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            importWs.Name = "ImportTemp"
            
            With importWs.QueryTables.Add(Connection:="TEXT;" & importFilePath, Destination:=importWs.Cells(1, 1))
                .TextFileParseType = xlDelimited
                .TextFileCommaDelimiter = True
                .Refresh BackgroundQuery:=False
            End With
            
            Dim ws As Worksheet
            Set ws = ThisWorkbook.Sheets(SHEET_NAME_MAIN)
            
            Dim lastRow As Long
            lastRow = GetLastDataRow(ws)
            
            Dim importLastRow As Long
            importLastRow = GetLastDataRow(importWs)
            
            ws.Range("A" & (lastRow + 1) & ":H" & (lastRow + importLastRow)).Value = importWs.Range("A2:H" & importLastRow + 1).Value
            
            Application.DisplayAlerts = False
            importWs.Delete
            Application.DisplayAlerts = True
            
            MsgBox "Data imported successfully!", vbInformation
        End If
    End With
End Sub
ThisWorkbook
vba
Private Sub Workbook_Open()
    On Error GoTo ErrorHandler
    Call InitializeFullEmailTracker
    Call AutoBackupScheduler
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred while opening the workbook: " & Err.Description, vbExclamation
    Debug.Print "Error in Workbook_Open: " & Err.Description
    Resume Next
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error GoTo ErrorHandler
    Call AutoBackup
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred while closing the workbook: " & Err.Description, vbExclamation
    Debug.Print "Error in Workbook_BeforeClose: " & Err.Description
    Resume Next
End Sub
Sheet1 (Main Sheet)
vba
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    On Error GoTo ErrorHandler
    Call HyperlinkClicked(Target)
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred while handling hyperlink: " & Err.Description, vbExclamation
    Debug.Print "Error in Worksheet_FollowHyperlink: " & Err.Description
    Resume Next
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error GoTo ErrorHandler
    If Not Intersect(Target, Me.Columns(1)) Is Nothing Then
        Call HyperlinkClicked(Target.Hyperlinks(1))
        Cancel = True
    End If
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred while handling double-click: " & Err.Description, vbExclamation
    Debug.Print "Error in Worksheet_BeforeDoubleClick: " & Err.Description
    Resume Next
End Sub


can you check and fix cause its saying error on line 

Sub InitializeFullEmailTracker()

saying sub or function not defined