Compare Excel worksheets(repost)
$5-10 USD
Posted about 15 years ago
$5-10 USD
Paid on delivery
I need a Excel macro that will compare 2 worksheets.? The results of the comparison will be displayed on a third worksheet.? I've downloaded some? vb source code that works almost to my specifications.? It should serve as a good starting point. The macro should be able to compare two worksheets with several thousand rows each.
## Deliverables
This code will compare 2 Excel worksheets and place the differences on a third worksheets.
*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
? ? ? [login to view URL] = False
? ? ? [login to view URL] = "Creating the report..."
? ? ? Set rptWB = [login to view URL]
? ? ? [login to view URL] = False
? ? ? While [login to view URL] > 1
? ? ? ? ? ? ? Worksheets(2).Delete
? ? ? Wend
? ? ? [login to view URL] = True
? ? ? With [login to view URL]
? ? ? ? ? ? ? lr1 = .[login to view URL]
? ? ? ? ? ? ? lc1 = .[login to view URL]
? ? ? End With
? ? ? With [login to view URL]
? ? ? ? ? ? ? lr2 = .[login to view URL]
? ? ? ? ? ? ? lc2 = .[login to view URL]
? ? ? 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
? ? ? ? ? ? ? [login to view URL] = "Comparing cells " & Format(c / maxC, "0 %") & "..."
? ? ? ? ? ? ? For r = 1 To maxR
? ? ? ? ? ? ? ? ? ? ? cf1 = ""
? ? ? ? ? ? ? ? ? ? ? cf2 = ""
? ? ? ? ? ? ? ? ? ? ? On Error Resume Next
? ? ? ? ? ? ? ? ? ? ? cf1 = [login to view URL](r, c).FormulaLocal
? ? ? ? ? ? ? ? ? ? ? cf2 = [login to view URL](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
? ? ? [login to view URL] = "Formatting the report..."
? ? ? With Range(Cells(1, 1), Cells(maxR, maxC))
? ? ? ? ? ? ? .[login to view URL] = 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
? ? ? [login to view URL] = True
? ? ? If DiffCount = 0 Then
? ? ? ? ? ? ? [login to view URL] False
? ? ? End If
? ? ? Set rptWB = Nothing
? ? ? [login to view URL] = False
? ? ? [login to view URL] = True
? ? ? MsgBox DiffCount & " cells contain different formulas!", vbInformation, _
? ? ? ? ? ? ? "Compare " & [login to view URL] & " with " & [login to view URL]
End Sub*
*This example macro shows how to use the macro above:
Sub TestCompareWorksheets()
? ? ? ' compare two different worksheets in the active workbook
? ? ? CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
? ? ? ' compare two different worksheets in two different workbooks
? ? ? CompareWorksheets [login to view URL]("Sheet1"), _
? ? ? ? ? ? ? Workbooks("[login to view URL]").Worksheets("Sheet2")
End Sub*
The two worksheests that I will be using has thousands of rows of data each.? Worksheet1 will? consist of new data and Worksheet2 will be made of original data.
?
I would like the code to do the following:
INPUT:? 2 worksheets with 33 columns each.? Worksheet1 can have anywhere between 1 and several thousand rows.? Worksheet2 will normally have several thousand rows.? Focus should be on 4 specific columns: Action, bank_No, Code, and program.? 'Action' will only be populated in worksheet1 with the values add, remove, or update
1.? Sort worksheet1 by ‘Action’
2.? If [login to view URL] = ‘Add’, then?
? ? ? ? ? ? ? ? 1. Read Worksheet1.(No, Code, Program)?
? ? ? ? ? ? ? ? 2.? Search Worksheet2 for Worksheet1.(No, Code, Program)?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? i.? If found, SUB FOUND( )?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ii.? If not found, SUB NOT FOUND ( )
? ? ? ? If [login to view URL] = ‘Remove’, then?
? ? ? ? ? ? ? ? 1.? Read Worksheet1.(No, Code, Program)?
? ? ? ? ? ? ? ? 2.? Search Worksheet2 for Worksheet1.(No, Code, Program)?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? iii. If found,?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 1.? Copy entire row to worksheet3?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 2. update [login to view URL] to ‘NOT REMOVED’?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 3.? highlight row in red?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? iv.? If not found?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 1.? Copy entire row to worksheet3?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 2.? update [login to view URL] to ‘REMOVED’?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 3.? highlight row light blue
? ? ? ? If [login to view URL] = ‘Update’, then?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 1.? Read Worksheet1.(No, Code, Program)?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 2.? Search Worksheet2 for Worksheet1.(No, Code, Program)?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? v.? ? If found, SUB FOUND( )?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? vi.? If not found, SUB NOT FOUND ( )
SUB FOUND ( )
1.? Compare each cell
2.? If cells are identical and [login to view URL] = ‘Add’?
? ? ? ? ? ? ? ? i.? ? Copy the row from worksheet1 to worksheet3?
? ? ? ? ? ? ? ? ii.? ? Change [login to view URL] to ‘ADDED’?
? ? ? ? ? ? ? ? iii.? Highlight row light green
3.? ? If cells are identical and [login to view URL] = ‘Update’?
? ? ? ? ? ? ? ? i.? Compare each cell from worksheet1 with worksheet2?
? ? ? ? ? ? ? ? ? ? ? ? 1.? ? If identical:?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? a.? Copy the row from worksheet1 to worksheet3?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? b.? Change [login to view URL] to ‘UPDATED’?
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? c.? Highlight row light yellow
4.? ? If one or more cells do not match:?
? ? ? ? ? ? ? ? ? ? ? ? a.? ? Copy the row from worksheet1 to worksheet3?
? ? ? ? ? ? ? ? ? ? ? ? b.? ? Bold the different cells?
? ? ? ? ? ? ? ? ? ? ? ? c.? ? ? Highlight row in red?
? ? ? ? ? ? ? ? ? ? ? ? d.? ? ? Change [login to view URL] to ‘UPDATE ERROR’
SUB NOT FOUND ( )
1.? Copy the row from worksheet1 to worksheet3
2.? Change [login to view URL] to ‘MISSING’
3.? Highlight row light red
?
Project ID: 3760806
About the project
9 proposals
Remote project
Active 15 yrs ago
Looking to make some money?
Benefits of bidding on Freelancer
Set your budget and timeframe
It's free to sign up and bid on jobs
9 freelancers are bidding on average $8 USD for this job
$8.50 USD in 17 days
4.9 (350 reviews) $8.50 USD in 17 days
4.9 (80 reviews) $8.50 USD in 17 days
4.7 (43 reviews) $8.50 USD in 17 days
4.8 (14 reviews) $6.80 USD in 17 days
4.9 (2 reviews) $8.50 USD in 17 days
5.0 (2 reviews) $8.50 USD in 17 days
4.5 (1 review) $8.50 USD in 17 days
0.0 (0 reviews)