PDA

View Full Version : How to improve the performance of this code



bunty
06-21-2010, 04:09 AM
Hi friends...
I have two excel sheet which contain some records(near about 10000).I need to compare each records of two sheet and copy the non matching records into another sheet.
I wrote some code which is working fine but the performance is very low(its taking so much time).e.g- for 100 records its taking 7sec.Please help me how to improve the performance.Below is the given code..its important.
thanks...


Sub compare_move()

FinalRowSh2 = Worksheets("New").Range("A65536").End(xlUp).Row

For i = 2 To FinalRowSh2
SourceRowData = ""

' x.Cells(1, 1).Value = i
Worksheets("Difference").Cells(1, 1).Value = i
'Label1.Caption = "Processing Row " & i & " of " & FinalRowSh2


Dim rg As Range, x As Variant

x = Worksheets("New").Range("A" & i & ":AR" & i).Value

For j = 1 To 44
'SourceRowData = SourceRowData & Worksheets("Sheet2").Cells(i, j)
SourceRowData = SourceRowData & x(1, j)
Next j

Call CheckDataExists(SourceRowData, i)
Next i
End Sub


Sub CheckDataExists(SourceRowData, RowNum)
FinalRowSh1 = Worksheets("Old").Range("A65536").End(xlUp).Row
Dim i As Integer

CheckRowExists = False
If FinalRowSh1 > 1 Then
i = 2
While CheckRowExists = False And i < FinalRowSh1

'For i = 1 To FinalRowSh1

TargetRowData = ""

For j = 1 To 44
TargetRowData = TargetRowData & Worksheets("Old").Cells(i, j)
Next j

If TargetRowData = SourceRowData Then
CheckRowExists = True
End If


i = i + 1

'Next i

Wend

End If
If CheckRowExists = False Then
CopyRowToThirdSheet (RowNum)
End If

End Sub

shrivallabha
06-21-2010, 04:16 AM
Add Following at the beginning
application.displayalerts = false
application.screenupdating = false

And at the end turn them on
application.displayalerts = true
application.screenupdating = true

Hope this helps...!

bunty
06-21-2010, 07:52 AM
hi shrivallabha,
first thanks for your help.I did what u said but there is no improvement.If you want a table also I will send you for better understanding the problem.Need your guidance.
thanks

shrivallabha
06-21-2010, 08:13 AM
That was my primary guess since Excel would spend time showing its action on-screen. I could not think of any other.

bunty
06-21-2010, 08:32 AM
I have one idea but i dont know how to implement the code because I am very new in VBA.
Can we convert excel file to csv file then compare the text.I think it will improve performance. If you know can you please write the code for me.
thanks

p45cal
06-21-2010, 10:00 AM
Try the following, but it's due diligence on you to test and check it thoroughly. I think I could speed it up some more but it might be fast enough as it is:
Sub compare_move()
Application.ScreenUpdating = False
FinalRowSh2 = Worksheets("New").Range("A65536").End(xlUp).Row
For i = 2 To FinalRowSh2
Worksheets("Difference").Cells(1, 1).Value = i
Call CheckDataExists(Worksheets("New").Range("A" & i & ":AR" & i), i)
Next i
Application.ScreenUpdating = True
End Sub
Sub CheckDataExists(SourceRowData, RowNum)
Dim i As Integer
ColumnsCount = SourceRowData.Columns.Count
With Worksheets("Old")
FinalRowSh1 = .Range("A65536").End(xlUp).Row
CheckRowExists = False
If FinalRowSh1 > 1 Then
For i = 2 To FinalRowSh1
If SourceRowData.Cells(1) = .Cells(i, 1) Then
Set TargetRowData = .Cells(i, 1).Resize(, ColumnsCount)
RowIsTheSame = True
For j = 2 To ColumnsCount
If SourceRowData.Cells(j) <> TargetRowData.Cells(j) Then
RowIsTheSame = False
Exit For
End If
Next j
If RowIsTheSame Then
CheckRowExists = True
Exit For
End If
End If
Next i
End If
If CheckRowExists = False Then CopyRowToThirdSheet (RowNum)
End With
End Sub

bunty
06-22-2010, 12:45 PM
Thanks Dear...yes its improve the performance but can you please explain the code.what you have done.One more thing I need from you that how to highlight
the non matching cell.
once again thanks for you help...

mdmackillop
06-22-2010, 02:29 PM
A slightly different approach.

Option Explicit
Option Base 1
Sub compare_move()
Dim NewData, OldData
Dim arrN, arrO
Dim Rws(), r
Dim i As Long, j As Long, k As Long, x As Long
Dim Chk As Boolean

With Sheets("New")
NewData = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 44).Value
End With
With Sheets("Old")
OldData = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 44).Value
End With

ReDim Rws(UBound(NewData))
For i = 1 To UBound(NewData)
arrN = Application.Index(NewData, i)
For j = 1 To UBound(OldData)
arrO = Application.Index(OldData, j)
Chk = False
k = 1
Do While arrN(k) = arrO(k)
k = k + 1
If k = 45 Then
Rws(i) = i
Chk = True
Exit Do
End If
Loop
If Chk = True Then Exit For
Next
Next
Application.ScreenUpdating = False
For i = 1 To UBound(NewData)
If Rws(i) = i Then
x = x + 1
Sheets("New").Cells(i, 1).Resize(, 44).Copy Sheets("Difference").Cells(x, 1)
End If
Next
Application.ScreenUpdating = True
End Sub

p45cal
06-22-2010, 02:59 PM
It takes each row of data in the New sheet, passes it to the second sub which:
1. runs down the first column of Old sheet looking to see if the first (leftmost) cell is the same, once it finds a match
2. it then loops comparing the rest of the cells in that row, one at a time. As soon as it finds a difference, then that row must be different, so it abandons checking that row any further and looks for another match in the first column. 3. It's only if every cell is the same on a given row that
CheckRowExists is set to true.
4. If, after checking every row in Old a match has not been found then CopyRowToThirdSheet gets called.

It can't show which cell is non matching as all of them are non-matching at some point!

bunty
06-22-2010, 09:57 PM
thanks dear...but i am not clear about that.can you please comment in a code so its easy for me to understand....aur if possible give some small example.
thanks

mdmackillop
06-23-2010, 12:05 AM
Hi bunty,
It would be better for you to provide an example upon which we can test our solutions.

bunty
06-23-2010, 10:36 AM
hi friends..
As I am very new in Vba .Can you please explain what actually this method is doing.If possible please give me some example or comment this code.so it will help me to understand the use of each line.
thanks to all..


Sub CheckDataExists(SourceRowData, RowNum)
Dim i As Integer
ColumnsCount = SourceRowData.Columns.Count
With Worksheets("Old")
FinalRowSh1 = .Range("A65536").End(xlUp).Row
CheckRowExists = False
If FinalRowSh1 > 1 Then
For i = 2 To FinalRowSh1
If SourceRowData.Cells(1) = .Cells(i, 1) Then
Set TargetRowData = .Cells(i, 1).Resize(, ColumnsCount)
RowIsTheSame = True
For j = 2 To ColumnsCount
If SourceRowData.Cells(j) <> TargetRowData.Cells(j) Then
RowIsTheSame = False
Exit For
End If
Next j
If RowIsTheSame Then
CheckRowExists = True
Exit For
End If
End If
Next i
End If
If CheckRowExists = False Then CopyRowToThirdSheet (RowNum)
End With
End Sub

Cyberdude
06-23-2010, 04:15 PM
Something that sometimes helps a lot to speed things up is to use the statement:

Application.Calculation = xlManual

Use it at the start of your macro, then at the end use

Application.Calculation = xlAutomatic

NOTE! If you use the first statement at the beginning, you MUST use the second statement at the end to prevent possible problems later.
Sid

bunty
06-23-2010, 09:47 PM
HI...
SPPOSE YOU HAVE 2 EXCEL WORKSHEET WHICH CONTAIN 100 ROWS AND 40 COLUMN.ANY ONE PLEASE EXPLAIN THESE CODE BASED ON THIS TABLE.
THANKS

If SourceRowData.Cells(1) = .Cells(i, 1) Then
Set TargetRowData = .Cells(i, 1).Resize(, ColumnsCount)
RowIsTheSame = True
For j = 2 To ColumnsCount
If SourceRowData.Cells(j) <> TargetRowData.Cells(j) Then
RowIsTheSame = False
Exit For
End If
Next j
If RowIsTheSame Then
CheckRowExists = True
Exit For
End If
End If

mdmackillop
06-23-2010, 11:47 PM
You have given no feedback on the posted solutions. Without this, we don't know if it is of value to progress these, or waste time trying to explain things.
You could even try to understand the last code with two small samples on paper, and follow the code steps. It's better for you to work out a simple code like this than a detailed explanation.

bunty
06-24-2010, 11:48 AM
hi Md,
thanks for your help,I tried the code which you have posted but thats not working.I wanted to explain the problem once again.we have two worksheet (one is old and other is new).which contain near about 10000 rows and 50 column.I wanted to compare each row of new table with all rows of old worksheet.I need to find and send non matching row to another sheet i.e (difference sheet) and highlight which cell is non matched using color anything.If you got any solution please explain me.

thanks

mdmackillop
06-24-2010, 11:50 AM
Please refer to Post #11

brettdj
06-26-2010, 11:33 PM
Once you have provided direction then note Malcolm has provided you with optimised code - working with arrays can be orders of magnitude faster than cell by cell loop writes

Dave