I would like to compare rows in two different sheets, highlighting the differences, and counting the number of differences. I'm using Windows 7, Excel 2013, and am new to VBA.
First worksheet is like this :
The second worksheet is like this :
The second worksheet's name matches a string in one of the cells in the first worksheet. Using this as a reference point, I'd like to start comparing all rows until the cell in column A is empty (meaning this part of the table has ended, and the next one will begin). Note, that column names do not necessarily match, but the order is the same. I would like to highlight the differences in red on the second sheet, as well as add a column counting the total number of cells in the row (not counting the first ID column) and a column counting the total number of differences in that row.
An example of what i'm going for:
What I've tried so far, has gotten me to import the sheet, search the sheet for the name and find the cell reference where it is found. I have some more code that I found from this thread : http://www.mrexcel.com/forum/excel-...atching-id-then-compare-other-values-row.html, but I'm not sure how to get it to search only the part of the table I'm looking for.
Option Explicit
Private Sub CommandButton1_Click()
' Get workbook...
Dim ws As Worksheet, ws1 As Worksheet, wsSHP As Worksheet
Dim filter As String
Dim targetWorkbook As Workbook, wb As Workbook
Dim Ret As Variant, OpenMsg As String, WholeName As String, FileName As String
Dim Caption As String
Dim CompNameRng As Range, c As Range, a As Range
Set targetWorkbook = Application.ActiveWorkbook
Set ws1 = Sheets("ws1")
' get the customer workbook
'filter = "Text files (*.xlsx),*.xlsx"
Caption = "Please Select an input file "
Ret = Application.GetOpenFilename(filter, , Caption)
If Ret = False Then Exit Sub
Set wb = Workbooks.Open(Ret)
wb.Sheets(1).Move After:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count)
If Ret = "False" Then Exit Sub
WholeName = Dir(Ret, vbDirectory)
FileName = Split(WholeName, ".")(0)
ActiveSheet.Name = FileName
Set wsSHP = Sheets(FileName)
Set CompNameRng = Sheets("Attributs").Range("A:A").Find(FileName, , xlValues, xlWhole)
If Not CompNameRng Is Nothing Then
MsgBox "Find has matched " & FileName & vbNewLine & " corresponding cell is " & CompNameRng.Offset(0, 1)
MsgBox "Found at " & CompNameRng.Address
'MsgBox "Next row starts at " & CompNameRng.Offset(1)
Else
MsgBox FileName & " not found"
End If
With ws1
For Each c In .Range(CompNameRng.Address, .Range("A" & Rows.Count).End(xlUp))
Set a = wsSHP.Columns(1).Find(c.Value, LookAt:=xlWhole)
If Not a Is Nothing Then
If .Cells(c.Row, 6).Value <> wsSHP.Cells(a.Row, 6) Then
wsSHP.Cells(a.Row, 6).Font.Color = vbRed
ElseIf .Cells(c.Row, 6).Value = wsSHP.Cells(a.Row, 6) Then
wsSHP.Cells(a.Row, 6).Font.Color = vbGreen
End If
End If
Next c
MsgBox "Done"
End With
End Sub
First worksheet is like this :
The second worksheet is like this :
The second worksheet's name matches a string in one of the cells in the first worksheet. Using this as a reference point, I'd like to start comparing all rows until the cell in column A is empty (meaning this part of the table has ended, and the next one will begin). Note, that column names do not necessarily match, but the order is the same. I would like to highlight the differences in red on the second sheet, as well as add a column counting the total number of cells in the row (not counting the first ID column) and a column counting the total number of differences in that row.
An example of what i'm going for:
What I've tried so far, has gotten me to import the sheet, search the sheet for the name and find the cell reference where it is found. I have some more code that I found from this thread : http://www.mrexcel.com/forum/excel-...atching-id-then-compare-other-values-row.html, but I'm not sure how to get it to search only the part of the table I'm looking for.
Option Explicit
Private Sub CommandButton1_Click()
' Get workbook...
Dim ws As Worksheet, ws1 As Worksheet, wsSHP As Worksheet
Dim filter As String
Dim targetWorkbook As Workbook, wb As Workbook
Dim Ret As Variant, OpenMsg As String, WholeName As String, FileName As String
Dim Caption As String
Dim CompNameRng As Range, c As Range, a As Range
Set targetWorkbook = Application.ActiveWorkbook
Set ws1 = Sheets("ws1")
' get the customer workbook
'filter = "Text files (*.xlsx),*.xlsx"
Caption = "Please Select an input file "
Ret = Application.GetOpenFilename(filter, , Caption)
If Ret = False Then Exit Sub
Set wb = Workbooks.Open(Ret)
wb.Sheets(1).Move After:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count)
If Ret = "False" Then Exit Sub
WholeName = Dir(Ret, vbDirectory)
FileName = Split(WholeName, ".")(0)
ActiveSheet.Name = FileName
Set wsSHP = Sheets(FileName)
Set CompNameRng = Sheets("Attributs").Range("A:A").Find(FileName, , xlValues, xlWhole)
If Not CompNameRng Is Nothing Then
MsgBox "Find has matched " & FileName & vbNewLine & " corresponding cell is " & CompNameRng.Offset(0, 1)
MsgBox "Found at " & CompNameRng.Address
'MsgBox "Next row starts at " & CompNameRng.Offset(1)
Else
MsgBox FileName & " not found"
End If
With ws1
For Each c In .Range(CompNameRng.Address, .Range("A" & Rows.Count).End(xlUp))
Set a = wsSHP.Columns(1).Find(c.Value, LookAt:=xlWhole)
If Not a Is Nothing Then
If .Cells(c.Row, 6).Value <> wsSHP.Cells(a.Row, 6) Then
wsSHP.Cells(a.Row, 6).Font.Color = vbRed
ElseIf .Cells(c.Row, 6).Value = wsSHP.Cells(a.Row, 6) Then
wsSHP.Cells(a.Row, 6).Font.Color = vbGreen
End If
End If
Next c
MsgBox "Done"
End With
End Sub
