compare the two excel by VB code and store mismatch in csv file

[code_world]

Hi
i have written a VB code to compare the two excel file. if i run this code for 1000 record so it compare the data in 10 min but if records the more the 2000 then it took long time.

Attached the comparison logic.

So how can i improve the performance the code?

Thanks

[Hack]

Moved From The FAQ Section

[code_world]

thanks Hack.... i have posted the question wrong place... you put at right place.... so can any one help me out to improve the performance the code...

[caohuy51190]

i have the same problem. Did you resolved it yet?

[vbfbryce]

If you want to give us some specifics (like how your data is arranged in the two files that you're comparing), we could probably help you...

[caohuy51190]

I have two tables. The first one contains two columns: Product name and Price. The second one have 2 columns too: Product name and Quantity. In the second table, product name may be repeated. I want to compare the 2nd Table with the 1st one, caculate the total value of the products in the 2nd table. The problem is the number of row in 2 tables is very large so it takes VB 10 minutes to get the result. Can you give any advices. Thanks! (Sorry if my English is not good)

[vbfbryce]

are the two tables in the same worksheet or different? same workbook, or different?

[vbfbryce]

I put my price table in columns A & B with the headers in row 1 (Product in col A, Price in col B). I have the Product and Qty in columns D and E, again with the headers in row 1. This code will put the price in column F and the "Extended Value" in column G:

Sub calcVal()
    Dim ws As Worksheet
    Dim lr1 As Long
    Dim lr2 As Long
    Dim rngKey1 As Range
    Dim rngSort1 As Range
    Dim rngKey2 As Range
    Dim rngSort2 As Range
    Dim rngLookup As Range
    
    Application.ScreenUpdating = False
    
    Set ws = ActiveSheet
    lr1 = ws.Range("a" & Rows.Count).End(xlUp).Row
    lr2 = ws.Range("d" & Rows.Count).End(xlUp).Row
    Set rngKey1 = ws.Range("a2:a" & lr1)
    Set rngSort1 = ws.Range("a1:b" & lr1)
    Set rngKey2 = ws.Range("d2:d" & lr2)
    Set rngSort2 = ws.Range("d1:e" & lr2)
    
    With ws
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=rngKey1, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange rngSort1
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=rngKey2, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange rngSort2
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        Set rngLookup = .Range("a2:b" & lr1)
        
        For i = 2 To lr2
            .Range("f" & i).Value = Application.WorksheetFunction.VLookup(.Range("d" & i).Value, rngLookup, 2)
            .Range("g" & i).Value = .Range("e" & i).Value * .Range("f" & i).Value
        Next i
        .Range("f1").Value = "Price"
        .Range("g1").Value = "Extended"
        Application.ScreenUpdating = True
    End With
    
    
End Sub