FixEncodingWithLogging.vba

Sub FixingEncodingIssuesAdvanced()
    Dim cell As Range
    Dim replacements As Object
    Dim key As Variant
    Dim originalValue As String
    Dim newValue As String
    Dim changedCount As Long
    Dim logFile As Integer
    Dim logPath As String
    Dim timestamp As String
    Dim cellAddress As String
    
    ' Create timestamp for log file
    timestamp = Format(Now(), "yyyy-mm-dd_hh-nn-ss")
    logPath = ThisWorkbook.Path & "\EncodingFixes_" & timestamp & ".txt"
    
    ' Open log file for writing
    logFile = FreeFile
    Open logPath For Output As #logFile
    
    ' Write header to log
    Print #logFile, "=================================="
    Print #logFile, "Encoding Fix Log"
    Print #logFile, "Date: " & Format(Now(), "yyyy-mm-dd hh:nn:ss")
    Print #logFile, "Workbook: " & ThisWorkbook.Name
    Print #logFile, "Worksheet: " & ActiveSheet.Name
    Print #logFile, "=================================="
    Print #logFile, ""
    
    ' Create dictionary of replacements
    Set replacements = CreateObject("Scripting.Dictionary")
    
    ' ====================================================================
    ' UTF-8 TO CP-1252/LATIN-1 DOUBLE-ENCODING ISSUES
    ' ====================================================================
    
    ' Lowercase accented letters (À-ÿ range)
    replacements.Add "Ã ", "à"
    replacements.Add "á", "á"
    replacements.Add "â", "â"
    replacements.Add "ã", "ã"
    replacements.Add "ä", "ä"
    replacements.Add "Ã¥", "å"
    replacements.Add "æ", "æ"
    replacements.Add "ç", "ç"
    replacements.Add "è", "è"
    replacements.Add "é", "é"
    replacements.Add "ê", "ê"
    replacements.Add "ë", "ë"
    replacements.Add "ì", "ì"
    replacements.Add "í", "í"
    replacements.Add "î", "î"
    replacements.Add "ï", "ï"
    replacements.Add "ð", "ð"
    replacements.Add "ñ", "ñ"
    replacements.Add "ò", "ò"
    replacements.Add "ó", "ó"
    replacements.Add "ô", "ô"
    replacements.Add "õ", "õ"
    replacements.Add "ö", "ö"
    replacements.Add "÷", "÷"
    replacements.Add "ø", "ø"
    replacements.Add "ù", "ù"
    replacements.Add "ú", "ú"
    replacements.Add "û", "û"
    replacements.Add "ü", "ü"
    replacements.Add "ý", "ý"
    replacements.Add "þ", "þ"
    replacements.Add "ÿ", "ÿ"
    replacements.Add "ß", "ß"
    
    ' Uppercase accented letters (À-Ý range)
    replacements.Add "À", "À"
    replacements.Add "Ã", "Á"
    replacements.Add "Â", "Â"
    replacements.Add "Ã", "Ã"
    replacements.Add "Ä", "Ä"
    replacements.Add "Ã…", "Å"
    replacements.Add "Æ", "Æ"
    replacements.Add "Ç", "Ç"
    replacements.Add "È", "È"
    replacements.Add "É", "É"
    replacements.Add "Ê", "Ê"
    replacements.Add "Ë", "Ë"
    replacements.Add "ÃŒ", "Ì"
    replacements.Add "Ã", "Í"
    replacements.Add "ÃŽ", "Î"
    replacements.Add "Ã", "Ï"
    replacements.Add "Ã", "Ð"
    replacements.Add "Ã'", "Ñ"
    replacements.Add "Ã'", "Ò"
    replacements.Add "Ã"", "Ó"
    replacements.Add "Ã"", "Ô"
    replacements.Add "Õ", "Õ"
    replacements.Add "Ö", "Ö"
    replacements.Add "×", "×"
    replacements.Add "Ø", "Ø"
    replacements.Add "Ù", "Ù"
    replacements.Add "Ú", "Ú"
    replacements.Add "Û", "Û"
    replacements.Add "Ãœ", "Ü"
    replacements.Add "Ã", "Ý"
    replacements.Add "Þ", "Þ"
    
    ' ====================================================================
    ' POLISH SPECIAL CHARACTERS
    ' ====================================================================
    replacements.Add "Ä…", "ą"
    replacements.Add "Ä„", "Ą"
    replacements.Add "ć", "ć"
    replacements.Add "Ć", "Ć"
    replacements.Add "Ä™", "ę"
    replacements.Add "Ę", "Ę"
    replacements.Add "Å‚", "ł"
    replacements.Add "Å", "Ł"
    replacements.Add "Å„", "ń"
    replacements.Add "Ń", "Ń"
    replacements.Add "Å›", "ś"
    replacements.Add "Åš", "Ś"
    replacements.Add "ź", "ź"
    replacements.Add "Ź", "Ź"
    replacements.Add "ż", "ż"
    replacements.Add "Å»", "Ż"
    
    ' ====================================================================
    ' CZECH/SLOVAK SPECIAL CHARACTERS
    ' ====================================================================
    replacements.Add "Ä", "č"
    replacements.Add "ÄŒ", "Č"
    replacements.Add "Ä", "ď"
    replacements.Add "ÄŽ", "Ď"
    replacements.Add "Ä›", "ě"
    replacements.Add "Äš", "Ě"
    replacements.Add "Ň", "ň"
    replacements.Add "Ň", "Ň"
    replacements.Add "Å™", "ř"
    replacements.Add "Ř", "Ř"
    replacements.Add "Å¡", "š"
    replacements.Add "Å ", "Š"
    replacements.Add "Å¥", "ť"
    replacements.Add "Ť", "Ť"
    replacements.Add "ů", "ů"
    replacements.Add "Å®", "Ů"
    replacements.Add "ž", "ž"
    replacements.Add "Ž", "Ž"
    replacements.Add "Å•", "ő"
    replacements.Add "Å"", "Ő"
    replacements.Add "ű", "ű"
    replacements.Add "Å°", "Ű"
    
    ' ====================================================================
    ' TURKISH SPECIAL CHARACTERS
    ' ====================================================================
    replacements.Add "ı", "ı"
    replacements.Add "Ä°", "İ"
    replacements.Add "ÄŸ", "ğ"
    replacements.Add "Äž", "Ğ"
    replacements.Add "ÅŸ", "ş"
    replacements.Add "Åž", "Ş"
    
    ' ====================================================================
    ' ROMANIAN SPECIAL CHARACTERS
    ' ====================================================================
    replacements.Add "Å£", "ţ"
    replacements.Add "Å¢", "Ţ"
    replacements.Add "È™", "ș"
    replacements.Add "Ș", "Ș"
    replacements.Add "È›", "ț"
    replacements.Add "Èš", "Ț"
    
    ' ====================================================================
    ' LATVIAN/LITHUANIAN SPECIAL CHARACTERS
    ' ====================================================================
    replacements.Add "Ä", "ā"
    replacements.Add "Ä€", "Ā"
    replacements.Add "Ä"", "ē"
    replacements.Add "Ä'", "Ē"
    replacements.Add "Ä£", "ģ"
    replacements.Add "Ä¢", "Ģ"
    replacements.Add "Ä«", "ī"
    replacements.Add "Ī", "Ī"
    replacements.Add "Ä·", "ķ"
    replacements.Add "Ķ", "Ķ"
    replacements.Add "ļ", "ļ"
    replacements.Add "Ä»", "Ļ"
    replacements.Add "ņ", "ņ"
    replacements.Add "Å…", "Ņ"
    replacements.Add "Å«", "ū"
    replacements.Add "Ū", "Ū"
    
    ' ====================================================================
    ' ICELANDIC/NORDIC SPECIAL CHARACTERS
    ' ====================================================================
    replacements.Add "ð", "ð"
    replacements.Add "Ã", "Ð"
    replacements.Add "þ", "þ"
    replacements.Add "Þ", "Þ"
    
    ' ====================================================================
    ' CP-1252 SPECIFIC: SMART QUOTES AND PUNCTUATION (0x80-0x9F range)
    ' ====================================================================
    ' These are the special CP-1252 characters that don't exist in ISO-8859-1
    
    ' Quotes
    replacements.Add "“", """    ' Left double quote (U+201C)
    replacements.Add "â€", """     ' Right double quote (U+201D)
    replacements.Add "‘", "'"     ' Left single quote (U+2018)
    replacements.Add "’", "'"     ' Right single quote (U+2019)
    replacements.Add "„", "„"     ' Double low quote (U+201E)
    replacements.Add "›", "›"     ' Single right angle quote (U+203A)
    replacements.Add "‹", "‹"     ' Single left angle quote (U+2039)
    replacements.Add "«", "«"      ' Left guillemet
    replacements.Add "»", "»"      ' Right guillemet
    
    ' Dashes
    replacements.Add "â€"", "–"     ' En dash (U+2013)
    replacements.Add "â€"", "—"     ' Em dash (U+2014)
    replacements.Add "―", "―"     ' Horizontal bar (U+2015)
    
    ' Other punctuation
    replacements.Add "…", "…"     ' Ellipsis (U+2026)
    replacements.Add "•", "•"     ' Bullet (U+2022)
    replacements.Add "‰", "‰"     ' Per mille (U+2030)
    replacements.Add "†", "†"     ' Dagger (U+2020)
    replacements.Add "‡", "‡"     ' Double dagger (U+2021)
    
    ' ====================================================================
    ' CURRENCY AND SYMBOLS
    ' ====================================================================
    replacements.Add "€", "€"     ' Euro
    replacements.Add "£", "£"      ' Pound
    replacements.Add "Â¥", "¥"      ' Yen
    replacements.Add "¢", "¢"      ' Cent
    replacements.Add "¤", "¤"      ' Currency sign
    
    ' Copyright and trademark
    replacements.Add "©", "©"      ' Copyright
    replacements.Add "®", "®"      ' Registered
    replacements.Add "â„¢", "™"     ' Trademark
    
    ' Math and special symbols
    replacements.Add "°", "°"      ' Degree
    replacements.Add "±", "±"      ' Plus-minus
    replacements.Add "²", "²"      ' Superscript 2
    replacements.Add "³", "³"      ' Superscript 3
    replacements.Add "¹", "¹"      ' Superscript 1
    replacements.Add "µ", "µ"      ' Micro
    replacements.Add "¶", "¶"      ' Pilcrow (paragraph)
    replacements.Add "·", "·"      ' Middle dot
    replacements.Add "¸", "¸"      ' Cedilla
    replacements.Add "º", "º"      ' Masculine ordinal
    replacements.Add "ª", "ª"      ' Feminine ordinal
    replacements.Add "´", "´"      ' Acute accent
    replacements.Add "¨", "¨"      ' Diaeresis
    replacements.Add "¯", "¯"      ' Macron
    replacements.Add "¬", "¬"      ' Not sign
    replacements.Add "­", "­"      ' Soft hyphen
    
    ' Fractions
    replacements.Add "¼", "¼"      ' 1/4
    replacements.Add "½", "½"      ' 1/2
    replacements.Add "¾", "¾"      ' 3/4
    
    ' Punctuation
    replacements.Add "¿", "¿"      ' Inverted question mark
    replacements.Add "¡", "¡"      ' Inverted exclamation
    
    ' ====================================================================
    ' HTML ENTITIES (in case they appear in data)
    ' ====================================================================
    replacements.Add "'", "'"
    replacements.Add """, """"
    replacements.Add "&", "&"
    replacements.Add "&lt;", "<"
    replacements.Add "&gt;", ">"
    replacements.Add "&nbsp;", " "
    replacements.Add "O&#39;", "O'"
    
    ' ====================================================================
    ' COMMON CORRUPTION PATTERNS
    ' ====================================================================
    replacements.Add "�", "�"     ' Unicode replacement character
    replacements.Add "Ð", "'"       ' Often a corrupted apostrophe
    replacements.Add "�", "-"     ' Corrupted dash
    replacements.Add "Â", ""       ' Often appears as phantom character
    
    ' ====================================================================
    ' TRIPLE-ENCODED ISSUES (UTF-8 encoded twice)
    ' ====================================================================
    ' These are less common but can happen with multiple import/export cycles
    replacements.Add "é", "é"
    replacements.Add "è", "è"
    replacements.Add "ê", "ê"
    replacements.Add "ë", "ë"
    replacements.Add "à", "à"
    replacements.Add "â", "â"
    replacements.Add "ô", "ô"
    replacements.Add "û", "û"
    replacements.Add "ü", "ü"
    replacements.Add "ö", "ö"
    replacements.Add "ä", "ä"
    replacements.Add "ç", "ç"
    replacements.Add "ñ", "ñ"
    replacements.Add "Ú", "š"
    replacements.Add "ÃŽ", "Ž"
    
    ' ====================================================================
    ' PROCESS CELLS
    ' ====================================================================
    
    changedCount = 0
    Application.ScreenUpdating = False  ' Speed up processing
    
    For Each cell In ActiveSheet.UsedRange.Cells
        If Not IsEmpty(cell.Value) And VarType(cell.Value) = vbString Then
            originalValue = cell.Value
            newValue = originalValue
            
            ' Apply all replacements
            For Each key In replacements.Keys
                If InStr(newValue, key) > 0 Then
                    newValue = Replace(newValue, key, replacements(key))
                End If
            Next key
            
            ' Only update if changed
            If newValue <> originalValue Then
                cell.Value = newValue
                changedCount = changedCount + 1
                cellAddress = cell.Address(False, False)
                
                ' Write to log file
                Print #logFile, "Row " & cell.Row & ", Column " & cell.Column & " (" & cellAddress & "):"
                Print #logFile, "  BEFORE: " & originalValue
                Print #logFile, "  AFTER:  " & newValue
                Print #logFile, ""
            End If
        End If
    Next cell
    
    Application.ScreenUpdating = True
    
    ' Write summary to log
    Print #logFile, "=================================="
    Print #logFile, "SUMMARY"
    Print #logFile, "=================================="
    Print #logFile, "Total cells processed: " & ActiveSheet.UsedRange.Cells.Count
    Print #logFile, "Cells with fixes: " & changedCount
    Print #logFile, "Encoding patterns checked: " & replacements.Count
    Print #logFile, ""
    Print #logFile, "Log file saved to: " & logPath
    
    ' Close log file
    Close #logFile
    
    ' Notify user
    If changedCount > 0 Then
        MsgBox "Fixed " & changedCount & " cell(s) with encoding issues!" & vbCrLf & vbCrLf & _
               "Log file saved to:" & vbCrLf & logPath & vbCrLf & vbCrLf & _
               "Party on Wayne!", vbInformation, "Encoding Fixes Complete"
    Else
        MsgBox "No encoding issues found. Your data is clean!" & vbCrLf & vbCrLf & _
               "Log file saved to:" & vbCrLf & logPath, vbInformation, "Encoding Check Complete"
    End If
    
End Sub