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

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!!

Answer 1

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