how can i do my code by dictionary to make it fast

[abdelfattah]

hi
i need help to make my code fast by dictionary i have about 10000 rows to copy data from main sheet to other sheets based on values of column

Sub My_Ad_filter()
Dim Rg As Range
Dim Cret_rg As Range
Dim arr, itm
Application.ScreenUpdating = False
arr = Array(sheet1, sheet2, sheet3, sheet4)
Set Rg = Sheets("g").Range("A14").CurrentRegion
For Each itm In arr
  With Sheets(itm & "")
    .Range("A14").CurrentRegion.ClearContents
    .Range("aa1") = "depart"
    .Range("aa2") = itm
     Set Cret_rg = .Range("aa1:aa2")
     Rg.AdvancedFilter 2, Cret_rg, .Range("A14")
     Cret_rg.ClearContents
  End With
Next
Application.ScreenUpdating = True
End Sub

thanks

 

[abdelfattah]

this what i got 0.13

 

[DanteAmor]

arr = Array(sheet1, sheet2, sheet3, sheet4)

I mean in the way you put that line, it means that sheet1, sheet2, sheet3 and sheet4 are variables, when executing the macro, if those variables are not filled, then you will have an error in this line:
With Sheets(itm & "")

Do you have any other code that you are not showing?

first of all i can't give you how long time takes if you have a way to do that please inform me

Just take any clock, run the macro, and check how long the clock advanced until the macro ends.

how can i do my code by dictionary to make it fast

If you want to make your macro faster, then you need to measure, how long it takes now and how long it takes with some other procedure, that way you will know if the new macro is faster.

 

[abdelfattah]

hi, dante sheet1, sheet2, sheet3 and sheet4 theses matches with sheets'name in my workbook so i have no problem with the code no error and i have no any code else except what i show and i use the clock it takes not exactly 1 sec you can say less than of it

 

[DanteAmor]

And do you want the process to be faster than one second?

 

[abdelfattah]

so you consider this faster no need make faster ?

 

[DanteAmor]

so you consider this faster no need make faster ?

I did not affirm anything or deny anything, I just want to know what your need is.


I think you have a good macro. With 10,000 records 0.14 seconds
My macro with 10,000 records 0.26 seconds

The following is my best shot, doing the process in memory for 4 sheets.

Sub My_Ad_filter_2()
  Dim a As Variant, b, c, d, e, arr As Variant, itm As Variant
  Dim i As Long, k As Long, col As Long
  Dim f As Range
  Dim m As Long, n As Long, p As Long, q As Long
 
  col = Sheets("g").Rows(14).Find("depart", , xlValues, xlWhole, , , False).Column
  a = Sheets("g").Range("A14").CurrentRegion
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
  ReDim d(1 To UBound(a, 1), 1 To UBound(a, 2))
  ReDim e(1 To UBound(a, 1), 1 To UBound(a, 2))
 
  m = m + 1
  For k = 1 To UBound(a, 2)
    b(m, k) = a(1, k)
  Next
  n = n + 1
  For k = 1 To UBound(a, 2)
    c(n, k) = a(1, k)
  Next
  p = p + 1
  For k = 1 To UBound(a, 2)
    d(p, k) = a(1, k)
  Next
  q = q + 1
  For k = 1 To UBound(a, 2)
    e(q, k) = a(1, k)
  Next
 
  For i = 2 To UBound(a)
    Select Case LCase(a(i, col))
      Case "sheet1"
        m = m + 1
        For k = 1 To UBound(a, 2)
          b(m, k) = a(i, k)
        Next
      Case "sheet2"
        n = n + 1
        For k = 1 To UBound(a, 2)
          c(n, k) = a(i, k)
        Next
      Case "sheet3"
        p = p + 1
        For k = 1 To UBound(a, 2)
          d(p, k) = a(i, k)
        Next
      Case "sheet4"
        q = q + 1
        For k = 1 To UBound(a, 2)
          e(q, k) = a(i, k)
        Next
    End Select
  Next
 
  arr = Array("sheet1", "sheet2", "sheet3", "sheet4")
  For Each itm In arr
    Sheets(itm).Range("A14").CurrentRegion.ClearContents
  Next
  Sheets("sheet1").Range("A14").Resize(m, UBound(b, 2)).Value = b
  Sheets("sheet2").Range("A14").Resize(n, UBound(c, 2)).Value = c
  Sheets("sheet3").Range("A14").Resize(p, UBound(d, 2)).Value = d
  Sheets("sheet4").Range("A14").Resize(q, UBound(e, 2)).Value = e
End Sub

 

[abdelfattah]

honestly, Dante your code is much better about its fast it gives me 0.05 sec at first glance i though the code doesn't work but i 'm surprising when i found the data in sheets great work thanks so much

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.