PDA

View Full Version : comparision macro is very slow



ramserp
06-13-2010, 05:12 AM
I have written a macro for comparing sheet1 with sheet2 and copying differences to third sheet,each sheet contains 45 columns and 12000 rows.

The macro compares a row from sheet1 with all the rows from sheet2.

Please kindly provide me the logic to increse my macro speed.

please find the attachment.



Thanks & Regards
Ram

GTO
06-13-2010, 05:45 AM
A couple of hopefully quick questions:

Is the header row actually row 3 in the real wb, or is it row 1, or might it vary? If it may vary, are we safe in searching from row 1 (all columns) until we run into something, as to determine the header row this way?

I think this question is important. In the rows of data that we are checking, do we really need to worry about formatting, such as bold, underline, and such? I ask as with this many rows, we may find copy/paste slower than taking the vals over by themselves.

Mark

Paul_Hossler
06-13-2010, 07:35 AM
For me, I'd start with something like this.

There are some assumptions:

Sheet1 and 2 have the same structure and have a header row
There are the same number of rows
Any change should be reported



Option Explicit

Private Sub CommandButton1_Click()
Dim r As Long, c As Long, o As Long
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim rData As Range

Application.ScreenUpdating = False

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set ws3 = Worksheets("Sheet3")

Set rData = ws2.Cells(1, 1).CurrentRegion

o = 1
For r = 2 To ws2.Cells(1, 1).CurrentRegion.Rows.Count
For c = 1 To ws2.Cells(1, 1).CurrentRegion.Columns.Count
If ws1.Cells(r, c).Value <> ws2.Cells(r, c).Value Then
Call rData.Rows(r).Copy(ws3.Cells(o, 1))
o = o + 1
Exit For
End If
Next c
Next r
Application.ScreenUpdating = True
End Sub


Paul

GTO
06-13-2010, 10:47 AM
Similar I think, flipping the ranges into arrays...

Sub exaTrackDifferences_3()
Dim _
sht1 As Worksheet, _
sht2 As Worksheet, _
sht3 As Worksheet, _
rng As Range, _
rng2 As Range, _
i As Long, _
ii As Long, _
x As Long, _
y As Long, _
ary1 As Variant, _
ary2 As Variant

Set sht1 = ThisWorkbook.Worksheets("Old")
Set sht2 = ThisWorkbook.Worksheets("New")

'// Rather than loop thru all the sheets, maybe just 'bulldoze' thru it//
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Difference").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'// Set ranges on new and old sheet //
With sht1
Set rng = Range(RangeFound(.Cells, , .Cells(.Cells.Count), , , , xlNext), _
RangeFound(.Cells))
Set rng2 = sht2.Range(rng.Address)
End With

'// Fill two arrays to run thru //
ary1 = rng.Value: ary2 = rng2.Value
'// REplace the destination sheet //
With ThisWorkbook
Set sht3 = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
sht3.Name = "Difference"
End With

'// Copy the header //
sht1.Rows(rng.Row).Copy sht3.Rows(1)

'// Read thru the "cells" in the arrays. Upon finding a difference, //
'// grab the vals from the corresponding row in the new sheet; then //
'// jump to next row //
ii = 1
For x = LBound(ary1, 1) + 1 To UBound(ary1, 1)
For y = LBound(ary1, 2) To UBound(ary1, 2)
If Not ary1(x, y) = ary2(x, y) Then
ii = ii + 1
sht3.Cells(ii, 1).Resize(, UBound(ary1, 2)).Value = rng2.Rows(x).Value
GoTo Jump
End If
Next
Jump:
Next
sht3.Range(rng.Address).EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

GTO
06-13-2010, 10:49 AM
Oops... Needs function...

Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

ramserp
06-14-2010, 08:47 PM
Hi GTO and Paul,

Thank you very much for your reply. There won't be equal rows in the sheets. A row from sheet1 compares with all the rows with sheet2 then unmatching rows need to be moved to third row.

Paul

When I run your code I am getting error as "Application-defined or Object-defined error".

Please kindly correct the macro as per my requirement.

Thanks & Regards
Ramesh

shrivallabha
06-14-2010, 10:56 PM
You can build a query in MS-Access as well and once you are through with the query it'll give you flexibility to:

Choose the data not matching with the other sheet (i.e. Sheet1, Sheet2 or both) by just little option change in the query.

Will be faster as you would like.