0
\$\begingroup\$

This looping has no problem if I have under 100 rows in the looping table sheet. However, If it go over 100 rows, looping takes a while to filtering and paste value in looping sheet. Is there any way to optimize this VBA code to run faster?

Sub Testingloop()
Dim endrown As String
Dim ex As String
Dim ez As String
Dim eh As String
Dim eg As String
Dim el As String
Dim ee As String
Dim es As String
Dim ef As String
Dim ei As String
Dim i As Integer
Dim LastRowColumnA As Long: LastRowColumnA = Sheets("looping").Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
Sheets("looping table").Select
endrown = Sheets("looping table").Range("I1000").End(xlUp).Row
 For i = 3 To endrown
 ee= Cells(i, 9).Value
 ex= Cells(i, 10).Value
 ez= Cells(i, 11).Value
 es = Cells(i, 12).Value
 ef = Cells(i, 13).Value
 ei = Cells(i, 14).Value
 eh = Cells(i, 15).Value
 eg= Cells(i, 16)
 el= Cells(i, 17)
 Sheets("looping").Select
 ActiveSheet.UsedRange.AutoFilter Field:=1, Criteria1:=ee
 ActiveSheet.UsedRange.AutoFilter Field:=2, Criteria1:=ex
 ActiveSheet.UsedRange.AutoFilter Field:=3, Criteria1:=ez
 ActiveSheet.UsedRange.AutoFilter Field:=4, Criteria1:=es
 ActiveSheet.UsedRange.AutoFilter Field:=5, Criteria1:=ef 
 ActiveSheet.UsedRange.AutoFilter Field:=6, Criteria1:=ei
 ActiveSheet.UsedRange.AutoFilter Field:=7, Criteria1:=eh
 On Error Resume Next
 Range("H2:H" & LastRowColumnA).SpecialCells(xlCellTypeVisible).Value = eg
 Range("I2:I" & LastRowColumnA).SpecialCells(xlCellTypeVisible).Value = el
 ActiveSheet.ShowAllData
 Sheets("looping table").Select
 Next i
End Sub
Jamal
35.2k13 gold badges134 silver badges238 bronze badges
asked Feb 27, 2017 at 22:54
\$\endgroup\$
1
  • 4
    \$\begingroup\$ Please edit your title to summarize what your code does, as the watermark says, and as I mentioned earlier on Stack Overflow. Also include a description of the code - the more effort you put in presenting your code, the more likely reviewers are to put effort in reviewing it. \$\endgroup\$ Commented Feb 27, 2017 at 23:31

2 Answers 2

1
\$\begingroup\$
  • first off: avoid Select/Selection/Activate/ActiveXXX pattern and use fully qualified range references.

    this will lead to a better control over what ranges you're actually acting on and best performances without all that sheets jumping

    so since you're using "looping table" sheet for filtering criteria values reading purposes while the hard work is done in "looping" sheet you may want to act like follows

    With Sheets("looping table") '<--| reference "looping table" worksheet
     'your code to gather filter criteria values
    End With
    With Sheets("looping") '<--| reference "looping" worksheet
     'your code to do the filtering and writing
    End With
    
  • all those es variables filled with the content of cells on the same row call for arrays

    reading values from cell into an array and then use this latter for those values retrieval is a much better performing action

    like:

    Dim eFilters As Variant, eVals As Variant
    With Sheets("looping table") '<--| reference "looping table" worksheet
     eFilters = .Range("O3", .cells(.Rows.Count, "I").End(xlUp)).Value '<--| store its columns "I" to "O" values from row 3 down to column "I" last not empty one
     eVals = .Range("P3:Q" & .cells(.Rows.Count, "I").End(xlUp).Row).Value '<--| store its columns "P" to "Q" values from row 3 down to column "I" last not empty one
    End With
    
  • once you have those arrays you can nest two loops:

    • outer loop to go through their rows as if you were looping through "looping table" ones

      to this purpose the Application.Index() method comes very handy, where you can strip off a single row out of an array by typing:

      Application.Index(myArray,iRow,0) '<--| this references the iRowth row of myArray array

      so that

      Application.Index(myArray,iRow,0)(iCol)

      references myArray elementh in iRow row and iCol column

    • inner loop to AutoFilter each "looping" sheet column with corresponding Criteria

      so that all that:

       .AutoFilter Field:=1, Criteria1:=ee
       .AutoFilter Field:=2, Criteria1:=ex
       .AutoFilter Field:=3, Criteria1:=ez
       .AutoFilter Field:=4, Criteria1:=es
       .AutoFilter Field:=5, Criteria1:=ef 
       .AutoFilter Field:=6, Criteria1:=ei
       .AutoFilter Field:=7, Criteria1:=eh
      

      becomes something like

      For iFilter = LBound(eFilters, 2) To UBound(eFilters, 2) '<--| loop through 'eFilters' array columns 
       .AutoFilter Field:= someColumnIndex, Criteria1:=someCriteria 
      Next
      

      where someColumnIndex and someCriteria are to be, correspondingly, connected to current inner loop iterator and stripped off eFilters current row (from outer loop) array


all what above could result in the following code:

Sub Testingloop()
 Dim eFilters As Variant, eVals As Variant
 With Sheets("looping table")
 eFilters = .Range("O3", .cells(.Rows.Count, "I").End(xlUp)).Value
 eVals = .Range("P3:Q" & .cells(.Rows.Count, "I").End(xlUp).Row).Value
 End With
 Dim iFilter As Long, ieVals As Long
 Application.ScreenUpdating = False
 With Sheets("looping").UsedRange
 For ieVals = LBound(eFilters, 1) To UBound(eFilters, 1)
 For iFilter = LBound(eFilters, 2) To UBound(eFilters, 2)
 .AutoFilter Field:=1 + iFilter - LBound(eFilters, 2), Criteria1:=Application.Index(eFilters, ieVals, 0)(iFilter)
 Next
 If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then
 With .Resize(.Rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible)
 .Offset(, 7).Value = Application.Index(eVals, ieVals, 0)(1)
 .Offset(, 8).Value = Application.Index(eVals, ieVals, 0)(2)
 End With
 End If
 .AutoFilter
 Next
 End With
 Application.ScreenUpdating = True
End Sub
answered Feb 28, 2017 at 8:14
\$\endgroup\$
1
\$\begingroup\$

For a start:

Sub Testingloop()
' Move this to the top. It doesn't affect your code, but it is good practice
' to put statements like these at the top and bottom of your code to make them
' easy to find.
Application.ScreenUpdating = False 
' This should be a number type and not a string
Dim endrown As Long 
Dim ex As String
Dim ez As String
Dim eh As String
Dim eg As String
Dim el As String
Dim ee As String
Dim es As String
Dim ef As String
Dim ei As String
Dim i As Integer
Dim LastRowColumnA As Long
' Better method of loading in multiple args, this will allow you to get
' all of your args in one go, and thus will speed up performance a bit.
' Practicing this early will also make it easier to develop more complex
' projects in the future.
Dim arrArgs as Variant 
' Create objects to hold the main workbook and worksheet you reference
' This allows for accurate range references.
Dim wb as Workbook, Dim ws as Worksheet
' Thisworkbook refers to the workbook containing the code.
Set wb = ThisWorkbook
Set ws = wb.Sheets("looping")
' Create a variable to hold the usedrange.
Dim rUsed as Range
' Qualified your cells reference with 'ws' to ensure the proper range is set
LastRowColumnA = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
ws.Activate ' Use Activate over select, but it is best to avoid either
endrown = ws.Range("I1000").End(xlUp).Row
 For i = 3 To endrown
 ' When referring to the same object repeatedly, use a with block
 ' This does a few things, first it allows your code to skip evaluation
 ' of your 'ActiveSheet' reference since it is already told where to look.
 ' It also makes your code easier to read, cleaner, and more efficient.
 With ws
 ee = .Cells(i, 9).Value ' Be sure to qualify your cells references
 ex = .Cells(i, 10).Value
 ez = .Cells(i, 11).Value
 es = .Cells(i, 12).Value
 ef = .Cells(i, 13).Value
 ei = .Cells(i, 14).Value
 eh = .Cells(i, 15).Value
 eg = .Cells(i, 16).Value ' I am assuming you intended to get the value here
 el = .Cells(i, 17).Value
 End With
 ' Instead of referring to the different ranges you could do something like
 ' arrArgs = ws.Cells(i, 9).Resize(8, 1).Value
 ' Using a declared variable is good practice, and may improve performance slightly
 Set rUsed = ws.UsedRange
 With rUsed
 .AutoFilter Field:=1, Criteria1:=ee
 .AutoFilter Field:=2, Criteria1:=ex
 .AutoFilter Field:=3, Criteria1:=ez
 .AutoFilter Field:=4, Criteria1:=es
 .AutoFilter Field:=5, Criteria1:=ef 
 .AutoFilter Field:=6, Criteria1:=ei
 .AutoFilter Field:=7, Criteria1:=eh
 End With
 On Error Resume Next
 With ws
 .Range("H2:H" & LastRowColumnA).SpecialCells(xlCellTypeVisible).Value = eg
 .Range("I2:I" & LastRowColumnA).SpecialCells(xlCellTypeVisible).Value = el
 .ShowAllData
 End With
 Next i
End Sub

This won't make a tremendous impact on performance, but it will make your code easier to work with. I also strongly encourage you to use the array instead of creating a separate string for each value you need to filter by. Again, not a big performance impact, but a good start on improving your coding.

Finally, depending on what your code is attempting to do you could try performing the operations in an array. You may also want to consider changing the calculation mode of the worksheet to xlCalculationManual (or something like that).

answered Feb 28, 2017 at 1:49
\$\endgroup\$
2
  • \$\begingroup\$ This is a good start. It could use more explanation about what you changed in your answer and why those changes are important/useful. \$\endgroup\$ Commented Feb 28, 2017 at 12:16
  • \$\begingroup\$ Thanks for the feedback Kaz. I've added inline comments to make the changes clearer and to provide some reasoning behind them. \$\endgroup\$ Commented Feb 28, 2017 at 12:39

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.