VBA: Highlighting Mismatched Values in comparisons.

[jrawlin7]

A challenging one for someone....

I have a CSV comparison sheet (all working).

When my CSV's are compared is there a way to highlight the mismatched value? Like the example below:

Here is my Macro for when you import the CSV 2 file, I guess it'll live in there..


Sub ImportDatafromotherworksheet2()
Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook As Workbook
Dim rngSourceRange As Range
Dim rngDestination As Range
Set wkbCrntWorkBook = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.CSV"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
Workbooks.Open .SelectedItems(1)
Set wkbSourceBook = ActiveWorkbook
Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="$A$1:$A$5000", Type:=8)
wkbCrntWorkBook.Activate
Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="$A$6", Type:=8)
rngSourceRange.Copy rngDestination
rngDestination.CurrentRegion.EntireColumn.AutoFit
wkbSourceBook.Close False
Column_Width
End If
End With
End Sub
Sub Column_Width()
Columns("A").ColumnWidth = 50
RemoveBlankCells
End Sub

Sub RemoveBlankCells()

Dim rng As Range

'Store blank cells inside a variable
On Error GoTo NoBlanksFound
Set rng = Range("a6:a5000").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
'Delete blank cells and shift upward
rng.Rows.Delete shift:=xlShiftUp

Exit Sub

 

[mart37]

Maybe you can use this example:

Sub highlightdifferentsigns()
    Dim xStr As String
    Dim xRg1 As Range
    Dim xRg2 As Range
    Dim I As Long
    Dim J As Long
    Set xRg1 = ActiveSheet.Range("A7:A10")
    Set xRg2 = ActiveSheet.Range("C7:C10")
    For I = 0 To xRg2.Rows.Count - 1
        xStr = xRg1.Range("A1").Offset(I, 0).Value
        With xRg2.Range("A1").Offset(I, 0)
            .Font.ColorIndex = 1
            For J = 1 To Len(.Text)
                If Mid(.Text, J, 1) <> Mid(xStr, J, 1) Then .Characters(J, 1).Font.ColorIndex = 3
            Next
        End With
    Next I
End Sub

 

[jrawlin7]

Thanks

 

[mart37]

                If Mid(.Text, J, 1) <> Mid(xStr, J, 1) Then
                    .Characters(J, 1).Font.ColorIndex = 3
                    .Characters(J, 1).Font.Bold = True
                End If