VBA: Highlighting Mismatched Values in comparisons.

jrawlin7

New Member
Joined
Feb 28, 2021
Messages
15
Office Version
  1. 2013
Platform
  1. Windows
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:

1614598774250.png



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
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

mart37

Well-known Member
Joined
Aug 4, 2017
Messages
1,096
Office Version
  1. 2016
Platform
  1. Windows
Maybe you can use this example:
VBA Code:
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
 

mart37

Well-known Member
Joined
Aug 4, 2017
Messages
1,096
Office Version
  1. 2016
Platform
  1. Windows
VBA Code:
                If Mid(.Text, J, 1) <> Mid(xStr, J, 1) Then
                    .Characters(J, 1).Font.ColorIndex = 3
                    .Characters(J, 1).Font.Bold = True
                End If
 

Forum statistics

Threads
1,143,620
Messages
5,719,789
Members
422,244
Latest member
AYSHANA

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top