VBA exception error

Resume is only applicable to management of error conditions.
What are you doing here? Is this part of a loop section?

Sub RunReport()

Dim ws As Worksheet
    
    For Each ws In ActiveWorkbook.Worksheets
        ws.Visible = xlSheetVisible
    Next ws

Sheets("Shipment Data").Select
Range("A2:EZ1048576").Select
Selection.ClearContents
Range("C1:EZ1").Select
Selection.ClearContents

Dim cn As ADODB.Connection
Set cn = New ADODB.Connection

Dim DSN As String

Dim Password As Variant

If Sheets("Queries").Range("G5").Value = True Then Password = InputBox("Please enter your password here:") Else Password = ""

DSN = Sheets("Selection").Range("C2")

cn.Open "DSN=" & DSN & ";password =" & Password & "; ConnectionTimeout=0;"

Dim Query As String

Query = Sheets("Queries").Range("E2").Value

Dim rs As New ADODB.Recordset
Dim cmd As New ADODB.Command
Set rs = New ADODB.Recordset
Set cmd = New ADODB.Command

'headers

 Dim Fields As Range
 Set FieldRange = Range("A1")
 Set TableColumns = Range("A1:CC1")
 i = 1

 Range("A1").Select

    For i = 0 To rs.Fields.Count - 1
        Sheets("Shipment Data").Cells(1, i + 1) = rs.Fields(i).Name
    Next i

    
cmd.ActiveConnection = cn
cmd.CommandTimeout = 0
cmd.CommandText = Query

Set rs = cmd.Execute()
Sheets("Shipment Data").Range("A2").CopyFromRecordset rs
Set rs = Nothing

cn.Close
Set con = Nothing

Sheets("Shipment Data").Range("A1").Value = "Tracking Nbr"
Sheets("Shipment Data").Range("B1").Value = "Tracking Nbr Prefix"

Call ListOfHeaders
Call Changetonumber

If Sheets("Queries").Range("F24").Value = True Then
Call PullSurcharge_Details
Call CombineShipmentCharges
Else: Resume
End If

End Sub

Select allOpen in new window

SO you can simply remove the Else: Resume and call directly End IF
If it's false you have nothing other to do

Worked thanks!!