VBA script to compare New and Old Budgets

[cfo@k]

I am trying to automate via VBA, a model to compare two budgets, a new cost budget and an cost old budget, determining the variances between
(a) Q-columns(Volume of products)
(b) I-Columns (Value of cost budgets for products)

I need to use the Look Up Keys(built by concatenating columns K,L,M) to find the corresponding variance between columns Q of NEW and OLD Buds and produce the output on the 'CHANGE' sheet(Column Q). The same is applied to the values in Columns I on NEW and OLD Bud with the CHANGE sheet showing the variance in Colunm I.

I have a large number of cost-budgets to compare for a large portfolio of products. I have attached example files (excel 2003, 2007). Thank you for your help in advance.

[mdbct]

The following creates a copy the NEWBUD sheet which is called Compare. The macro then searches the OLDBUD sheet for each of the KEY-NEWB values on the Compare sheet. If there is a match, the values from the OLDBUD sheet's H and I columns are subtracting from the NEWBUD's H and I columns. If no matching KEY-NEWB is found in the OLDBUD sheet, "No Old" is entered into the H and I columns.

Sub compare()
    Dim shtCom As Worksheet, shtNew As Worksheet, shtOld As Worksheet
    Dim i As Long
    Dim rngKey As Range, rngKeyRow As Double
    Dim dHnew As Double, dInew As Double
    Dim dHold As Double, dIold As Double
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("compare").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Application.ScreenUpdating = False

    Set shtNew = Sheets("NEWBUD")
    Set shtOld = Sheets("OLDBUD")
    shtNew.Copy after:=Sheets(Sheets.Count)
    Set shtCom = ActiveSheet
    shtCom.Name = "Compare"

    i = 2

    Do Until shtCom.Cells(i, 1) = ""
        dHnew = shtCom.Cells(i, "H")
        dInew = shtCom.Cells(i, "I")

        Set rngKey = shtOld.Range("A:A").Find(what:=shtCom.Cells(i, 1).Value, LookIn:=xlValues, searchorder:=xlByRows)
        If Not rngKey Is Nothing Then
            rngKeyRow = rngKey.Row
            dHold = shtOld.Cells(rngKeyRow, "H")
            dIold = shtOld.Cells(rngKeyRow, "I")

            shtCom.Cells(i, "H") = dHnew - dHold
            shtCom.Cells(i, "i") = dInew - dIold
        Else
            shtCom.Cells(i, "H") = "no old"
            shtCom.Cells(i, "i") = "no old"
        End If
        i = i + 1
        Set rngKey = Nothing
    Loop

    Application.ScreenUpdating = True
End Sub