Comparing values or text in 2 different workbooks

[Mo]

Hello -

I am fairly new to VBA and I have a question to ask. I need to write a code
that compares market value, market price, shares, and portfolio numbers. So
if for example market price in wb1 is different than wb2 then it should write
in a new sheet portfolio number, market value, market price, and shares.

It must do the following:

1. compare values in 4 columns in workbook1 to 4 columns in workbook2.
2. if values of any of them are different then it should write in a new
sheet the information in the following format:
Row 1: wb1 - portfolio number - market price - market value - shares
Row 2: wb2 - portfolio number - market price - market value - shares
Row 3: Blank
Repeat
3. if portfolio number is blank then it should skip this entire field.

I really would appreciate all the help! Thanks!

 

[ryguy7272]

There are so many ways to do this! Look here:
http://www.softinterface.com/MD\Document-Comparison-Software.htm

For VBA code, try this:
#1)
Sub TestCompareWorksheets()
CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
End Sub
Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
Dim r As Long, c As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
Dim rptWB As Workbook, DiffCount As Long
Application.ScreenUpdating = False
Application.StatusBar = "Creating the report..."
Set rptWB = Workbooks.Add
Application.DisplayAlerts = False
While Worksheets.Count > 1
Worksheets(2).Delete
Wend
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
For c = 1 To maxC
Application.StatusBar = "Comparing cells " & Format(c / maxC, "0 %") & "..."
For r = 1 To maxR
cf1 = ""
cf2 = ""
On Error Resume Next
cf1 = ws1.Cells(r, c).FormulaLocal
cf2 = ws2.Cells(r, c).FormulaLocal
On Error GoTo 0
If cf1 <> cf2 Then
DiffCount = DiffCount + 1
Cells(r, c).Formula = "'" & cf1 & " <> " & cf2
End If
Next r
Next c
Application.StatusBar = "Formatting the report..."
With Range(Cells(1, 1), Cells(maxR, maxC))
..Interior.ColorIndex = 19
With .Borders(xlEdgeTop)
..LineStyle = xlContinuous
..Weight = xlHairline
End With
With .Borders(xlEdgeRight)
..LineStyle = xlContinuous
..Weight = xlHairline
End With
With .Borders(xlEdgeLeft)
..LineStyle = xlContinuous
..Weight = xlHairline
End With
With .Borders(xlEdgeBottom)
..LineStyle = xlContinuous
..Weight = xlHairline
End With
On Error Resume Next
With .Borders(xlInsideHorizontal)
..LineStyle = xlContinuous
..Weight = xlHairline
End With
With .Borders(xlInsideVertical)
..LineStyle = xlContinuous
..Weight = xlHairline
End With
On Error GoTo 0
End With
Columns("A:IV").ColumnWidth = 20
rptWB.Saved = True
If DiffCount = 0 Then
rptWB.Close False
End If
Set rptWB = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox DiffCount & " cells contain different formulas!", vbInformation, _
"Compare " & ws1.Name & " with " & ws2.Name
End Sub


#2)
Sub checkrev()

With Sheets("Sheet1")
Sh1LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set Sh1Range = .Range("A1:A" & Sh1LastRow)
End With
With Sheets("Sheet2")
Sh2LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set Sh2Range = .Range("A1:A" & Sh2LastRow)
End With

'compare sheet 1 with sheet 2
For Each Sh1cell In Sh1Range
Set c = Sh2Range.Find( _
what:=Sh1cell, LookIn:=xlValues)
If c Is Nothing Then
Sh1cell.Interior.ColorIndex = 3
Sh1cell.Offset(0, 1).Interior.ColorIndex = 3
Else
If Sh1cell.Offset(0, 1) <> c.Offset(0, 1) Then
Sh1cell.Interior.ColorIndex = 6
Sh1cell.Offset(0, 1).Interior.ColorIndex = 6
End If
End If
Next Sh1cell
'compare sheet 2 with sheet 1
For Each Sh2cell In Sh2Range
Set c = Sh1Range.Find( _
what:=Sh2cell, LookIn:=xlValues)
If c Is Nothing Then
Sh2cell.Interior.ColorIndex = 3
Sh2cell.Offset(0, 1).Interior.ColorIndex = 3
Else
If Sh2cell.Offset(0, 1) <> c.Offset(0, 1) Then
Sh2cell.Interior.ColorIndex = 6
Sh2cell.Offset(0, 1).Interior.ColorIndex = 6
End If
End If
Next Sh2cell

End Sub

If those don't work for you, and I am pretty sure they will, post back. I
have 4 other possible solutions.

HTH,
Ryan---

 

[Mo]

Wow! those were very good codes bud!! I will definitely be using them in
the future thanks!... Unfortunately however I may not have explained what I
need carefully. The codes are comparing cells A1 to A1, B1 to B1, etc.
between Sheet 1 and 2. What I need is a little more complicated...

Sheet 1 and 2 will have data that is not sorted at all. But Sheet 1 is
going to have the ORIGINAL data (the absolutely correct one). Sheet 2 will
need to be compared to sheet 1 and spit out any differences.

So I need the code to direct the comparison this way:
1. Data in Columns A will always be unique.
2. So choose Sheet1.A1 and look into Sheet2.A:A to find the corresponding
and equal value (could be in a completely different cell but will always be
in the same column).
3. If there is no match - type the CELL VALUE and "No Match Found" in the
report.
4. If there is a match - then I need it to compare the cells in THAT row.
For example, if Sheet1.A1 = 123 and that value is located in Sheet2.A9, then
compare the values in that entire row 9 to the ones in row 1 and spit out any
differences.

I really liked your way of highlighting the differences by actually writing
the mismatched values so that is something I want to incorporate here for
sure.

Thanks in advance!

Mo