Is there an alternative to a for-if loop in VBA?

Question

I've got two Worksheets in Excel. I've written the following code to copy some data from Worksheet 1 to Worksheet 2, based on some values that the user inserts in Worksheet 2.

The macro works fine, and does what I need it to do, but after writing it down I've come to realize two things:

It takes quite some time for a small set of records(260 or so), as it goes one row at a time.
I read that using .select is not good practice, and I modified the code so that I would not use it, but I'm left wondering if I could improve the code to work faster if I did use it.

So, my main questions are:

How can I improve the speed of the code, so that it will be able to read copy rows faster.
Would it be better in this case to use .select in my case, so that it would work faster.

My code is the following:

Private Sub FillUp()
Dim DateVal, EquivalentDate As Date
Dim CrncyVal
Dim CountrVal
Dim DataRng As Range
Dim endrow As Long, startrow As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
'Selecting the worksheets
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

''''declaring date, country and currency variables''''
DateVal = ws2.Range("E3").Value
CountryVal = UCase(ws2.Range("H3").Value)
CurrencyVal = UCase(ws2.Range("H4").Value)
EquivalentDateVal = DateAdd("yyyy", -1, DateVal)
'declaring other useful variables
startrow = 3
pasterow = 6
endrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
'delete the range we will be working with
ws2.Range("A6:F265").Clear

'start the ifs, to see what info the user wants to get
If ws2.Range("E3").Value = "" Then
    'If the country cell is empty, we do nothing. We need at least this info
    MsgBox prompt:="You didn't choose a month!!", Title:="Error: Please Choose a Month"
    Exit Sub
ElseIf ws2.Range("H3").Value = "" Then
    For i = 3 To endrow
        If ws1.Cells(i, 3).Value <> "TOT" Then

            With ws1
                Set Rng = .Range(.Cells(i, 1), .Cells(i, 5))
            End With

            Rng.Copy
            ws2.Cells(pasterow, 1).PasteSpecial
            ws2.Cells(pasterow, 6) = DateVal

            pasterow = pasterow + 1
        End If
    Next i
    Exit Sub

ElseIf ws2.Range("H4").Value = "" Then            
    For i = 3 To endrow
        If ws1.Cells(i, 3).Value <> "TOT" Then
            If ws1.Cells(i, 1).Value = CountryVal Then

                With ws1
                    Set Rng = .Range(.Cells(i, 1), .Cells(i, 5))
                End With

                Rng.Copy
                ws2.Cells(pasterow, 1).PasteSpecial
                ws2.Cells(pasterow, 6) = DateVal

                pasterow = pasterow + 1 
            End If
        End If
    Next i
    Exit Sub
Else
    For i = 3 To endrow
        If ws1.Cells(i, 3).Value <> "TOT" Then
            If ws1.Cells(i, 1).Value = CountryVal Then
                If ws1.Cells(i, 2).Value = CurrencyVal Then

                    With ws1
                        Set Rng = .Range(.Cells(i, 1), .Cells(i, 5))
                    End With

                    Rng.Copy
                    ws2.Cells(pasterow, 1).PasteSpecial
                    ws2.Cells(pasterow, 6) = DateVal

                    pasterow = pasterow + 1
                End If
            End If            
        End If
    Next i
    Exit Sub

End If
End Sub

Any help or opinion on how I can get the code to be faster or better in any way is welcome, as I am quite new to the whole Excel/VBA world.

Thanks!!

As this is working code without any obvious problems, this question is better suited for [codereview.stackexchange.com](https://codereview.stackexchange.com/). — Plutian, Nov 05 '19 at 10:54
`.Select` and `.Activate` is never a good practice untill you want it to be visible to user after the macro end. Here, you may use `AutoFilter` to get the thing done. — Dhirendra Kumar, Nov 05 '19 at 10:55
@Plutian: Not anymore actually. See [THIS](https://meta.stackoverflow.com/questions/390803/is-this-question-on-topic-for-code-review) — Siddharth Rout, Nov 05 '19 at 10:57
Alex You can use autofilter as @DhirendraKumar suggested. [Here](https://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s/11633207#11633207) is one example — Siddharth Rout, Nov 05 '19 at 11:02
@SiddharthRout Thanks for pointing that out, I wasn't aware of that. — Plutian, Nov 05 '19 at 11:22
@SiddharthRout Always found that a grey area myself but seems there actually is a firm line. Thanks for posting link. — QHarr, Nov 05 '19 at 11:23
the relevant points seem to be about narrowing the question for SO. For example, narrowing down to where bottlenecks occur. — QHarr, Nov 05 '19 at 11:25
Thanks both to @DhirendraKumar for giving the `AutoFilter` idea, and @SiddharthRout for providing an example. I will get back to the post when I manage to use it accordingly. — Alex O'Leary, Nov 05 '19 at 11:33
You might find it easier to use `Range.Find` and `Range.FindNext` methods to cycle through your data - just a thought.. — Dave, Nov 05 '19 at 11:55
@DhirendraKumar Thanks for your idea of using `Autofilter` to make the code faster! I've managed to get a working function. — Alex O'Leary, Nov 15 '19 at 10:29

score 0 · Accepted Answer · answered Nov 14 '19 at 15:27

Well, after some time and using DhirendraKumar 's idea to use Autofilter I've managed to get the code to work much faster. Thanks again!!

I'm answering the question so that anyone that might come searching for an answer can see this example and maybe apply it to their problem.

Answers

I've answered my first question with the code below. The speed has been improved by using Autofilter, it works faster because it doesn't go row by row.

I didn't use Select in my code, and I don't use Activate anymore, so I guess I did not need to use neither.

Sub FillUp()
Dim DateVal
Dim CountryVal
Dim CurrencyVal
Dim endrow As Long, lastrow As Long, pasterow As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet

'Selecting the worksheets
Set ws1 = Worksheets("Cost Evolution 2")
Set ws2 = Worksheets("Sheet1")

''''declaring date, country and currency variables''''
DateVal = ws2.Range("E3").Value
CountryVal = UCase(ws2.Range("H3").Value)
CurrencyVal = UCase(ws2.Range("H4").Value)

'declaring other useful variables
pasterow = 6
lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row

'delete the range we will be working with
ws2.Range("A6:F265").Clear

'start the ifs, to see what info the user wants to get
If DateVal = "" Then
    'If the country cell is empty, we do nothing. We need at least this info
    MsgBox prompt:="You didn't choose a month!!", Title:="Error: Please Choose a Month"
    Exit Sub
ElseIf CountryVal = "" Then
    With ws1.Range("A2:E2")
        .AutoFilter Field:=3, Criteria1:="<>TOT"
    End With

    ' make sure results were returned from the filter
    If (ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Address <> "$A$1") Then

        ws1.Range("A3:E" & lastrow).Copy ws2.Range("A" & CStr(pasterow))

        endrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row

        ws2.Range("F" & pasterow & ":F" & endrow).Formula = DateVal

        pasterow = endrow + 1
    End If

    ws1.AutoFilterMode = False
    MsgBox prompt:="Inserted complete month"
    Exit Sub

ElseIf CurrencyVal = "" Then
    With ws1.Range("A2:E2")
        .AutoFilter Field:=3, Criteria1:="<>TOT"
        .AutoFilter Field:=1, Criteria1:=CountryVal
    End With

    ' make sure results were returned from the filter
    If (ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Address <> "$A$1") Then

        ws1.Range("A3:E" & lastrow).Copy ws2.Range("A" & CStr(pasterow))

        endrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row

        ws2.Range("F" & pasterow & ":F" & endrow).Formula = DateVal

        pasterow = endrow + 1
    End If

    ws1.AutoFilterMode = False
    MsgBox prompt:="Inserted complete month for the chosen country"
    Exit Sub
Else
    With ws1.Range("A2:E2")
        .AutoFilter Field:=1, Criteria1:=CountryVal
        .AutoFilter Field:=2, Criteria1:=CurrencyVal
        .AutoFilter Field:=3, Criteria1:="<>TOT"
    End With

    ' make sure results were returned from the filter
    If (ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Address <> "$A$1") Then

        ws1.Range("A3:E" & lastrow).Copy ws2.Range("A" & CStr(pasterow))

        endrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row

        ws2.Range("F" & pasterow & ":F" & endrow).Formula = DateVal

        pasterow = endrow + 1
    End If

    ws1.AutoFilterMode = False
    MsgBox prompt:="Inserted complete month for the chosen country and currency"
    Exit Sub

End If
End Sub

Is there an alternative to a for-if loop in VBA?

1 Answers1