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
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
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
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.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.