how make this code faster(is too slow)

[tubrak]

hi
can any body help to make this code faster ,please ?
this code match data across multiple sheets and copy and merge duplicated data based on column B and calculate the quantity among the sheet

Sub calqt()
Dim Chk, Data, WsArr, Temp, i As Long, ii As Long, x As Long, rw As Long, Tm As Double
ReDim Temp(1 To 50000, 1 To 15): Tm = Timer
WsArr = [{"First", "Import", "Export", "Sales Returns", "Purchase Returns"}]
For i = 1 To UBound(WsArr)
    Data = Sheets(WsArr(i)).Cells(1).CurrentRegion.Value
    For ii = 2 To UBound(Data)
        Chk = Application.Match(Data(ii, 2), Application.Index(Temp, , 2), 0)
        If Not IsNumeric(Chk) Then
            x = x + 1
            Temp(x, 1) = x
            Temp(x, 2) = Data(ii, 2)
            Temp(x, 3) = Data(ii, 3)
            Temp(x, 4) = Data(ii, 4)
            Temp(x, 5) = Data(ii, 5)
            rw = x
        Else
            rw = Chk
        End If
        Temp(rw, i + 5) = Temp(rw, i + 5) + Data(ii, 6)
        If i = 1 Or i = 2 Then
            Temp(rw, 12) = Temp(rw, 12) + Data(ii, 7)
            Temp(rw, 14) = Temp(rw, 14) + 1
        End If
        If i = 1 Or i = 3 Then
            Temp(rw, 13) = Temp(rw, 13) + Data(ii, IIf(i = 1, 8, 7))
            Temp(rw, 15) = Temp(rw, 15) + 1
        End If
    Next ii
Next i
With Sheets("STOCK")
    .Range("A2").Resize(x, 15) = Temp
    .Range("K2:K" & x + 1).Formula = "=F2+G2-H2+I2-J2"
    With .Range("L2:L" & x + 1): .Value = Evaluate("=" & .Address & "/" & .Offset(, 2).Address & ""): End With
    With .Range("M2:M" & x + 1): .Value = Evaluate("=" & .Address & "/" & .Offset(, 2).Address & ""): End With
    .Columns(14).Resize(, 2).Delete: .UsedRange.Borders.Weight = 2
End With
MsgBox Format(Timer - Tm, "0.00")

End Sub

if any body interest I will attach the file if this is not enough to understand the code

 

[Fluff]

How about

Sub calqt()
Dim Chk, Data, WsArr, Temp, i As Long, ii As Long, x As Long, rw As Long, Tm As Double
Dim Dic As Object
ReDim Temp(1 To 50000, 1 To 15): Tm = Timer
Set Dic = CreateObject("scripting.dictionary")
WsArr = [{"First", "Import", "Export", "Sales Returns", "Purchase Returns"}]
For i = 1 To UBound(WsArr)
    Data = Sheets(WsArr(i)).Cells(1).CurrentRegion.Value
    For ii = 2 To UBound(Data)
        If Not Dic.exists(Data(ii, 2)) Then
            x = x + 1
            Dic.Add Data(ii, 2), x
            Temp(x, 1) = x
            Temp(x, 2) = Data(ii, 2)
            Temp(x, 3) = Data(ii, 3)
            Temp(x, 4) = Data(ii, 4)
            Temp(x, 5) = Data(ii, 5)
            rw = x
        Else
            rw = Dic(Data(ii, 2))
        End If
        Temp(rw, i + 5) = Temp(rw, i + 5) + Data(ii, 6)
        If i = 1 Or i = 2 Then
            Temp(rw, 12) = Temp(rw, 12) + Data(ii, 7)
            Temp(rw, 14) = Temp(rw, 14) + 1
        End If
        If i = 1 Or i = 3 Then
            Temp(rw, 13) = Temp(rw, 13) + Data(ii, IIf(i = 1, 8, 7))
            Temp(rw, 15) = Temp(rw, 15) + 1
        End If
    Next ii
Next i
With Sheets("STOCK")
    .Range("A2").Resize(x, 15) = Temp
    .Range("K2:K" & x + 1).Formula = "=F2+G2-H2+I2-J2"
    With .Range("L2:L" & x + 1): .Value = Evaluate("=" & .Address & "/" & .Offset(, 2).Address & ""): End With
    With .Range("M2:M" & x + 1): .Value = Evaluate("=" & .Address & "/" & .Offset(, 2).Address & ""): End With
    .Columns(14).Resize(, 2).Delete: .UsedRange.Borders.Weight = 2
End With
MsgBox Format(Timer - Tm, "0.00")

End Sub

 

[jasonb75]

I am in Australia and it is quite late here. If Jason can’t help have a look at this.

I'll be having a look at that link, thanks Alex!

Dictionaries are something that I don't understand and keep meaning to look at but never get around to it.

 

[tubrak]

@Fluff wow! it's a big difference gives 0.03
thanks so much

 

[tubrak]

I'll be having a look at that link, thanks Alex!

Dictionaries are something that I don't understand and keep meaning to look at but never get around to it.

thanks

 

[Fluff]

Glad we could help & thanks for the feedback.

 

[Alex Blakenburg]

I'll be having a look at that link, thanks Alex!

Dictionaries are something that I don't understand and keep meaning to look at but never get around to it.

Fluff’s method is easier, he just sets they dictionary key as the lookup value and then stores the array reference as the value against that key. It does mean you have to dimension that array somehow though.