this code become slow for 18000 rows despite of using dictionary and array

leap out

Active Member
Joined
Dec 4, 2020
Messages
271
Office Version
  1. 2016
  2. 2010
Hi experts
I got help from mr.Peter_Ss with some modification .
the code becomes more slowly when test for big data, despite of using dictionary & array
so the big data can be 18000 rows for each sheet . the code will calculation items based on column B and if there is duplicates items should merge for each sheet . the formula will be (stock-sales+pur-return) in sheet summary for last column ,also if there is new item in one of sheets but is not in another , then should also show and calculation . the code create whole data with format & borders and collect the data across sheet into sheet summary
VBA Code:
Sub CollateData_v4()
  Dim d As Object
  Dim ShList As Variant, a As Variant, vals As Variant
  Dim i As Long, j As Long
  Dim s As String
 
  Set d = CreateObject("Scripting.Dictionary")
  ShList = Split("stock|sales|pur|returns", "|")
  For j = 0 To UBound(ShList)
    With Sheets(ShList(j))
      a = .UsedRange.Value2
      For i = 2 To UBound(a)
        s = .Cells(i, 2)
        If Len(s) > 2 Then
         
        If Not d.exists(s) Then d(s) = Join(Application.Index(a, i, Array(3, 4, 5)), ";") & ";;;;"
          vals = Split(d(s), ";")
          If IsNumeric(vals(j + 3)) Then
           vals(j + 3) = vals(j + 3) + a(i, 6)
           Else
           vals(j + 3) = a(i, 6)
          End If
         
            d(s) = Join(vals, ";")
         
        End If
      Next i
    End With
  Next j
  Application.ScreenUpdating = False
  With Sheets("summary")
    .UsedRange.EntireRow.Delete
    With .Range("B2:C2").Resize(d.Count)
      .Value = Application.Transpose(Array(d.Keys, d.Items))
      With .Columns(2)
        .TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False
        With .Offset(, 7) ' ### was .Offset(, 5)
          .FormulaR1C1 = "=RC[-4]-RC[-3]+RC[-2]+RC[-1]"
          .Value = .Value
        End With
        '.Resize(, 3).EntireColumn.Insert '### not needed
      End With
      .Columns(1).TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False
      With .Columns(0)
        .Cells(1).Value = 1
        .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
      End With
    End With
    With .Range("A1:J1")
      .Value = Array("item", "CODE", "BRAND", "TYPE", "MANUFACTURE", "STOCK", "SALES", "PUR", "RETURNS", "BALANCE")
       .Font.Bold = True
  .Interior.Color = RGB(166, 166, 166)
      .EntireColumn.AutoFit
    End With
    With .UsedRange
      .BorderAround xlContinuous
      .Borders(xlInsideVertical).LineStyle = xlContinuous
      .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
  End With
  Application.ScreenUpdating = True
End Sub
for more detailes
INVEN with single search v0 c.xlsm
ABCDEF
1itemCODEBRANDTYPEMANUFACTUREQTY
21AA-110W40 208LQ8EU2222
32AA-215W40 208LCASSU400
43AA-35W30 208LQ8EU800
54AA-45W30 12x1LQ8EU600
65AA-510W40 208LENIIT300
76AA-65W30 4x4LQ8EU200
87AA-710W40 12x1LQ8EU120
98AA-815W40 12x1LCASSU450
109AA-910W40 12x1LENIIT890
1110AA-1010W40 4x4LQ8EU345
1211AA-1110W40 4x4LCASSU78
1312AA-1210W40 4x4LENIIT123
1413AA-135W40 4x4LQ8EU456
1514AA-145W40 4x4LCASSU678
1615AA-155W40 4x4LENIIT1234
1716AA-1620W50 4x4LQ8EU456
stock



INVEN with single search v0 c.xlsm
ABCDEF
1DATECODEBRANDTYPEMANUFACTURESALES
21/1/2021AA-110W40 208LQ8EU100
31/2/2021AA-215W40 208LCASSU50
41/3/2021AA-35W30 208LQ8EU280
51/4/2021AA-45W30 12x1LQ8EU300
61/5/2021AA-510W40 208LENIIT80
71/6/2021AA-65W30 4x4LQ8EU20
81/7/2021AA-710W40 12x1LQ8EU20
91/8/2021AA-815W40 12x1LCASSU20
101/9/2021AA-910W40 12x1LENIIT876
111/10/2021AA-1010W40 4x4LQ8EU345
121/11/2021AA-1110W40 4x4LCASSU123
131/12/2021AA-1210W40 4x4LENIIT78
141/13/2021AA-135W40 4x4LQ8EU300
151/14/2021AA-145W40 4x4LCASSU34
161/15/2021AA-155W40 4x4LENIIT23
171/16/2021AA-1620W50 4x4LQ8EU56
181/17/2021AA-110W40 208LQ8EU100
sales



INVEN with single search v0 c.xlsm
ABCDEF
1DATECODEBRANDTYPEMANUFACTUREPURCHASE
22/4/2021AA-110W40 208LQ8EU55
32/5/2021AA-215W40 208LCASSU20
42/6/2021AA-35W30 208LQ8EU10
52/7/2021AA-45W30 12x1LQ8EU10
62/8/2021AA-510W40 208LENIIT3
72/9/2021AA-65W30 4x4LQ8EU4
82/10/2021AA-710W40 12x1LQ8EU45
92/11/2021AA-815W40 12x1LCASSU8
102/12/2021AA-910W40 12x1LENIIT1
112/13/2021AA-1010W40 4x4LQ8EU100
122/14/2021AA-1110W40 4x4LCASSU20
132/15/2021AA-1210W40 4x4LENIIT100
142/16/2021AA-135W40 4x4LQ8EU44
152/17/2021AA-145W40 4x4LCASSU20
162/18/2021AA-155W40 4x4LENIIT50
172/19/2021AA-1620W50 4x4LQ8EU12
182/20/2021AA-1720W50 4x4LCASSU9
192/21/2021AA-1820W50 4x4LENIIT4
202/22/2021AA-110W40 208LQ8EU55
pur


INVEN with single search v0 c.xlsm
ABCDEF
1itemCODEBRANDTYPEMANUFACTUREreturns
24/5/2021AA-910W40 12x1LENIIT20
34/6/2021AA-1010W40 4x4LQ8EU30
44/7/2021AA-1110W40 4x4LCASSU40
54/8/2021AA-45W30 12x1LQ8EU10
64/9/2021AA-45W30 12x1LQ8EU11
returns



result
INVEN with single search v0 c.xlsm
ABCDEFGHIJ
1itemCODEBRANDTYPEMANUFACTURESTOCKSALESPURRETURNSBALANCE
21AA-110W40 208LQ8EU22222001102132
32AA-215W40 208LCASSU4005020370
43AA-35W30 208LQ8EU80028010530
54AA-45W30 12x1LQ8EU6003001021331
65AA-510W40 208LENIIT300803223
76AA-65W30 4x4LQ8EU200204184
87AA-710W40 12x1LQ8EU1202045145
98AA-815W40 12x1LCASSU450208438
109AA-910W40 12x1LENIIT89087612035
1110AA-1010W40 4x4LQ8EU34534510030130
1211AA-1110W40 4x4LCASSU78123204015
1312AA-1210W40 4x4LENIIT12378100145
1413AA-135W40 4x4LQ8EU45630044200
1514AA-145W40 4x4LCASSU6783420664
1615AA-155W40 4x4LENIIT123423501261
1716AA-1620W50 4x4LQ8EU4565612412
1817AA-1720W50 4x4LCASSU99
1918AA-1820W50 4x4LENIIT44
summary

can anybody make it fast,please?
 
@JEC thanks again . I accepted the code should replace new data for old data in sheet summary if I change or update data in the others sheets (this means the data in sheet summary should clear data before bring data from the other sheets)
I try to add this line
VBA Code:
 Sheets("summary").Range("A2").Resize(.Count, 10).ClearContents
but doesn't work. any suggestion please?
 
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
You could try

VBA Code:
Sheets("summary").UsedRange.Offset(1).ClearContents
 
Upvote 0
thanks it works , I note the formula doesn't calculate correctly as I said in OP
stock-sales+pur-return . your code works this stock-sales+pur+return
sorry I've found it too lately !
 
Upvote 0
thanks it works , I note the formula doesn't calculate correctly as I said in OP
stock-sales+pur-return . your code works this stock-sales+pur+return
sorry I've found it too lately !

@leap out, the 'summary' page you posted in the OP indicates the second formula should be used. That contradicts the first formula that you say should be used. ;)
 
Upvote 0
@JEC
I change this [CODE
a(9) = a(9) + IIf(j = 1, -ar(jj, 6), IIf(j = 3 And a(5) & a(6) & a(7) = "000", -ar(jj, 6), ar(jj, 6)))
[/CODE]
to this
VBA Code:
 a(9) = a(5) - a(6) + a(7) - a(8)
it seem to work , truly I don't understand how calculate for this line
VBA Code:
 a(9) = a(9) + IIf(j = 1, -ar(jj, 6), IIf(j = 3 And a(5) & a(6) & a(7) = "000", -ar(jj, 6), ar(jj, 6)))
it takes from me much time to try understand it .
the J=1, J=3 this means the sheets( sales,returns ) , is it right?
ar(jj, 6) is it the values in last column for each sheet sales,returns for the items in column C,D,E .?
a(5) & a(6) & a(7) should be the columns STOCK ,SALES,PUR in sheet summary ?
a(9) = last column in sheet summary?
as I understand for this line
VBA Code:
 a(9) = a(9) + IIf(j = 1, -ar(jj, 6), IIf(j = 3 And a(5) & a(6) & a(7) = "000", -ar(jj, 6), ar(jj, 6)))


that means it should calculate in last column in sheet summary by collect the columns stock,sales,pur & brings the values from sheets stock,sales,pur based on the last column , but I don't see a(8) the column RETURNS and I can't understand how calculat formula (stock-sales+pur+return) based on your code .
does my change is ok?
can you explain me how calculate in this line?
VBA Code:
 a(9) = a(9) + IIf(j = 1, -ar(jj, 6), IIf(j = 3 And a(5) & a(6) & a(7) = "000", -ar(jj, 6), ar(jj, 6)))

thanks
 
Upvote 0

Forum statistics

Threads
1,214,935
Messages
6,122,337
Members
449,077
Latest member
Jocksteriom

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top