Compare Excel worksheets

Cancelled Posted Mar 21, 2009 Paid on delivery
Cancelled 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

? ? ? [url removed, login to view] = False

? ? ? [url removed, login to view] = "Creating the report..."

? ? ? Set rptWB = [url removed, login to view]

? ? ? [url removed, login to view] = False

? ? ? While [url removed, login to view] > 1

? ? ? ? ? ? ? Worksheets(2).Delete

? ? ? Wend

? ? ? [url removed, login to view] = True

? ? ? With [url removed, login to view]

? ? ? ? ? ? ? lr1 = .[url removed, login to view]

? ? ? ? ? ? ? lc1 = .[url removed, login to view]

? ? ? End With

? ? ? With [url removed, login to view]

? ? ? ? ? ? ? lr2 = .[url removed, login to view]

? ? ? ? ? ? ? lc2 = .[url removed, login to view]

? ? ? 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

? ? ? ? ? ? ? [url removed, login to view] = "Comparing cells " & Format(c / maxC, "0 %") & "..."

? ? ? ? ? ? ? For r = 1 To maxR

? ? ? ? ? ? ? ? ? ? ? cf1 = ""

? ? ? ? ? ? ? ? ? ? ? cf2 = ""

? ? ? ? ? ? ? ? ? ? ? On Error Resume Next

? ? ? ? ? ? ? ? ? ? ? cf1 = [url removed, login to view](r, c).FormulaLocal

? ? ? ? ? ? ? ? ? ? ? cf2 = [url removed, login to view](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

? ? ? [url removed, login to view] = "Formatting the report..."

? ? ? With Range(Cells(1, 1), Cells(maxR, maxC))

? ? ? ? ? ? ? .[url removed, login to view] = 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

? ? ? [url removed, login to view] = True

? ? ? If DiffCount = 0 Then

? ? ? ? ? ? ? [url removed, login to view] False

? ? ? End If

? ? ? Set rptWB = Nothing

? ? ? [url removed, login to view] = False

? ? ? [url removed, login to view] = True

? ? ? MsgBox DiffCount & " cells contain different formulas!", vbInformation, _

? ? ? ? ? ? ? "Compare " & [url removed, login to view] & " with " & [url removed, login to view]

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 [url removed, login to view]("Sheet1"), _

? ? ? ? ? ? ? Workbooks("[url removed, login to view]").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 [url removed, login to view] = ‘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 [url removed, login to view] = ‘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 [url removed, login to view] to ‘NOT REMOVED’?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 3.? highlight row in red?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? iv.? If not found?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 1.? Copy entire row to worksheet3?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 2.? update [url removed, login to view] to ‘REMOVED’?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 3.? highlight row light blue

? ? ? ? If [url removed, login to view] = ‘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 [url removed, login to view] = ‘Add’?

? ? ? ? ? ? ? ? i.? ? Copy the row from worksheet1 to worksheet3?

? ? ? ? ? ? ? ? ii.? ? Change [url removed, login to view] to ‘ADDED’?

? ? ? ? ? ? ? ? iii.? Highlight row light green

3.? ? If cells are identical and [url removed, login to view] = ‘Update’?

? ? ? ? ? ? ? ? i.? Compare each cell from worksheet1 with worksheet2?

? ? ? ? ? ? ? ? ? ? ? ? 1.? ? If identical:?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? a.? Copy the row from worksheet1 to worksheet3?

? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? b.? Change [url removed, login to view] 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 [url removed, login to view] to ‘UPDATE ERROR’

SUB NOT FOUND ( )

1.? Copy the row from worksheet1 to worksheet3

2.? Change [url removed, login to view] to ‘MISSING’

3.? Highlight row light red

?

Engineering MySQL PHP Project Management Software Architecture Software Testing

Project ID: #3747897

About the project

6 proposals Remote project Active Mar 25, 2009

6 freelancers are bidding on average $8 for this job

bob1982

See private message.

$8.5 USD in 2 days
(366 Reviews)
7.0
velocityinf

See private message.

$6.8 USD in 2 days
(17 Reviews)
3.7
vw7195038vw

See private message.

$6.8 USD in 2 days
(4 Reviews)
2.3
satheez1984

See private message.

$6.8 USD in 2 days
(2 Reviews)
2.3
Abikris

See private message.

$8.5 USD in 2 days
(1 Review)
0.5
tvnvw

See private message.

$8.5 USD in 2 days
(0 Reviews)
0.0