Hi ALL!!
I have currently put together some code to enable me to compare two different data sources main HR file (This data is over 6000 lines long with approximetly 15 columns worth of data to be compared)
The Macro I have created so far is fit for the purpose in which I need it, however needs tweeking slightly in the way that it does not treat a upper and lower case as a difference.
Example 17B Glen Avenue, and 17b Glen Avenue is showing as a differences within my report but I'd like this not to happen.
I believe you can use a good few different options to make this work however what I have tried so far didnt work, therefore my question is, can anyone please help me to get the below code to be case insensitive???
I believe there is UPPER and LOWER, and also LIKE that can be used but I'm clearly not placing this correctly within my coding.
ALL HELP IS GREATLY APPRECIATED, in advance!!
______________________________________________________________________________________________________
Sub Compare()
'
' Macro1 Macro
'
' compare two different worksheets in the active workbook
CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
End Sub
Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
Dim dupRow As Boolean
Dim r As Long, c As Integer, m As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer, lr3 As Long
Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
Dim dupCount As Long
Application.ScreenUpdating = False
Application.StatusBar = "Creating the report..."
Application.DisplayAlerts = True
With ws1.UsedRange
lr1 = .Rows.Count
lc1 = .Columns.Count
End With
With ws2.UsedRange
lr2 = .Rows.Count
lc2 = .Columns.Count
End With
maxR = lr1
maxC = lc1
If maxR < lr2 Then maxR = lr2
If maxC < lc2 Then maxC = lc2
DiffCount = 0
lr3 = 1
For i = 1 To lr1
dupRow = True
Application.StatusBar = "Comparing cells " & Format(i / maxR, "0 %") & "..."
For r = 1 To lr2
For c = 1 To maxC
ws1.Select
cf1 = ""
cf2 = ""
On Error Resume Next
cf1 = ws1.Cells(i, c).FormulaLocal
cf2 = ws2.Cells(r, c).FormulaLocal
On Error GoTo 0
If cf1 <> cf2 Then
dupRow = False
Exit For
Else
dupRow = True
End If
Next c
If dupRow Then
dupCount = dupCount + 1
ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, maxC)).Select
Selection.Copy
Worksheets("Sheet3").Select
Worksheets("Sheet3").Range(Worksheets("Sheet3").Cells(lr3, 1), Worksheets("Sheet3").Cells(lr3, maxC)).Select
Selection.PasteSpecial
lr3 = lr3 + 1
ws1.Select
For t = 1 To maxC
ws1.Cells(i, t).Interior.ColorIndex = 19
ws1.Cells(i, t).Select
Selection.Font.Bold = True
Next t
End If
Next r
Next i
Application.StatusBar = "Formatting the report..."
'Columns("A:IV").ColumnWidth = 10
m = dupCount
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox m & " Rows contain same values!", vbInformation, _
"Compare " & ws1.Name & " LIKE " & ws2.Name
End Sub
Bookmarks