Optimising For...Next loops in Select Case - excel

I have three different CASEs in a bit of code, each of which has minor variations on a routine revolving around a For...Next loop. The question is, is there any difference in efficiency and speed depending on how I nest them?
In other words, is:
Select Case sPosition
Case Is = "First"
For j = 17 to 65
[Do stuff]
Next j
Case Is = "Middle"
For j = 17 to 65
[Do stuff]
Next j
Case Is = "Last"
For j = 17 to 65
[Do stuff]
Next j
End Select
...any more or less efficient than:
For j = 17 to 65
Select Case sPosition
Case Is = "First"
[Do stuff]
Case Is = "Middle"
[Do stuff]
Case Is = "Last"
[Do stuff]
End Select
Next j

More of a question for CodeReview than SO, but regardless, it is dependent on what you are intending to do with the loops. In the first situation, you have a condition and then you loop through the data in accordance with the result of the condition, doing the same thing for all the data. In the second case, you are re-checking the condition each time the loop runs. If you think different things will be happening as the loop runs (different Cases being selected), then you need to use the second variation, but if the checked condition is not changing, then the first option will be faster, as the condition is only checked once for the loop

I think first variant is more efficient because select case works only one time and in the second variant select case works for every step of cicle (49 times)

Related

Out of memory error copying cells from one sheet to another

There are a lot of questions regarding this issue. I read many of them and tried a few things but they don't fix my case.
I am trying to compare lines from two different (very long) sheets. If specific indices match then specific cells (always the same columns with the current line) need to be copied from one sheet into the other.
It looks like this just bigger (enlarged example):
Dim ArrayOne() as string
Dim ArrayTwo() as string
Redim ArrayOne (1 to AmountOfRowsSheet1)
Redim ArrayTwo (1 to AmountOfRowsSheet2)
For i = 1 to AmountOfRowsSheet1
ArrayOne(i) = Sheet1.Cells(i, ThisColumn)
next i
For i = 1 to AmountOfRowsSheet2
ArrayTwo(i) = Sheet2.Cells(i, ThatColumn)
next i
for i = 1 to 4600
for j = 1 to 69000
if ArrayOne(i) Like "*" & ArrayTwo(j) then
Sheet1.Cells(i, 5).value = Sheet3.Cells(i,10).value
'the line above is repeated about 20 times just with different columns
'so it gets potentially executed 4600*69000*20 times (6348000000)
end if
next j
next i
For-loop and everything is working, it also copies correctly but after an amount of lines I run out of memory. In the TaskManager I can see my used RAM tick up every few seconds. At one point Excel displays an error that it can't handle the next copying because of a lack of resources.
I tried:
Application.CutCopyMode = False '( at restart of loop)
Creating an empty data object and putting it into the clipboard.
and a few user32.dll fixes I found.
I turned your example into how you would work with arrays
Option Explicit
Sub Example()
Dim ArrayOne() As Variant
Dim ArrayTwo() As Variant
ArrayOne = Sheet1.Columns(1).Value 'read column 1 into array
ArrayTwo = Sheet2.Columns(2).Value 'read column 2 into array
Dim start
start = Timer
Dim i As Long
For i = 1 To 4600
Dim j As Long
For j = 1 To 69000
If ArrayOne(i, 1) Like "*" & ArrayTwo(j, 1) Then
Sheet.Cells(i, 5).Value = Sheet.Cells(i, 10).Value + 1
End If
Next j
Debug.Print i, start, Timer, "Runtime=" & Timer-start
Stop 'we want to test time of one iteration = 23 seconds
Next i
End Sub
This example run 23 seconds (on my computer) for one iteration of the j loop. So this will run in total 23*4600 seconds which is about 30 hours.
So either you strip down the data that needs to be processed or you use something else than Excel VBA to get it faster. Or you change your entire approach.
Note that VBA is limited to single threading. So no matter how many cores your CPU has VBA will only use one. That makes it actually a pretty bad tool for processing big data.
Actually what you need to get rid of is the read/write actions to the cells
Sheet.Cells(i, 5).Value = Sheet.Cells(i, 10).Value
Whenever you access a cell value it slows down a lot. Without that line the loop runs in 2 instead of 23 seconds (still a total runtime of 2.5 hours). So there is potential to get this faster, but probably not much faster than 2.5 hours.
If you cannot get rid of multiple read/write actions then even turning off calculation Application.Calculation = xlCalculationManual before going into the loop brings an immense boost. Just don't forget to turn it on Application.Calculation = xlCalculationAutomatic in the end. Note that turning off calculation only works if you have no formulas that need to be calculated while your loop runs (otherwise you get faulty results).
I recommend to try to improve your real code like above and check the runtime for one full run of the inner j loop as I did with the stop command. This way you can easily calculate the entire runtime by multiplication with 4600.
Not an answer to the question but instead of:
For i = 1 to AmountOfRowsSheet1
ArrayOne(i) = Sheet1.Cells(i, ThisColumn)
next i
try:
ArrayOne= Range(Cells(1, ThisColumn), Cells(AmountOfRowsSheet1, ThisColumn))
ArrayOne will be a 2D array, with data starting in (1,1) and incrementing (n,1)...
Quicker to get data and similar can be used for putting an array back into a worksheet - also miles quicker than a for loop.
Edit: Again, not direct answer to the question, but this:
import random, string
# ---------------------------------------------------------
#This part is just generating random data to compare against each other (and in case of lists 5 & 6, the data on the sheet in Sheets1(i,5) & Sheets3(i,10)
N1 = 6
list2 = []
list5 = [] #This would correspond to existing vals in Sheets(1.cells(i,5)
list6 = [] #and this to Sheets3.cells(i,10)
for i1 in range(0, 4600):
list2.append(''.join(random.choice(string.ascii_uppercase + string.digits) for _ in range(N1)))
list5.append(5)
list6.append(10)
N2 = 12
list3 = []
for i1 in range(0, 69000):
list3.append(''.join(random.choice(string.ascii_uppercase + string.digits) for _ in range(N2)))
list2[0] = "$$$$$$" #Just setting two values so we can check the method works
list3[10] = "$$$$££££££"
# ---------------------------------------------------------
#This part is actually doing what your trying to do in VBA
list4 = []
ij1 = 0
for j1 in list2:
found = False
for j2 in list3:
if j1 in j2:
found = True
break
if found:
list4.append(list6[j1])
else:
list4.append(list5[j1])
ij1 += 1
The bit your interested in runs in around 25 seconds. Absolutely no fancy code-work needed. Go look at downloading anaconda. You'd probably be quicker reading your two excel files into python, do your ops, then writing back out again than trying to do it purely in VBA.

VBA Greater Than Function Not Working

I have an issue where I am trying to compare a values that can be alphanumeric, only numeric, or only alphabetic.
The code originally worked fine for comparing anything within the same 100s group (IE 1-99 with alphabetic components). However when I included 100+ into it, it malfunctioned.
The current part of the code reads:
For j = 1 To thislength
If lennew < j Then
enteredval = Left("100A", lennew)
ElseIf lennew >= j Then
enteredval = Left("100A", j)
End If
If lenold < j Then
cellval = Left("67", lenold)
ElseIf lenold >= j Then
cellval = Left("67", j)
End If
'issue occurs here
If enteredval >= cellval Then
newrow = newrow+1
End If
Next j
The issue occurs in the last if statement.
When cycling through the 100 is greater than the 67 but still skips over. I tried to declare them both as strings (above this part of code) to see if that would help but it didn't.
What I am trying to accomplish is to sort through a bunch of rows and find where it should go. IE the 100A should go between 100 and 100B.
Sorry lennew=len("100A") and lennold=len("67"). And thislength=4or whatever is larger of the two lengths.
The problem is that you're trying to solve the comparison problem by attacking specific values, and that's going to be a problem to maintain. I'd make the problem more generic by creating a function that supplies takes two values returns -1 if the first operand is "before" the second, 0 if they are the same, and 1 if the first operand is "after" the second per your rules.
You could then restructure your code to eliminate the specific hardcoded prefix testing and then just call the comparison function directly, eg (and this is COMPLETELY untested, off-the-cuff, and my VBA is VERRRRRY stale :) but the idea is there: (it also assumes the existence of a simple string function called StripPrefix that just takes a string and strips off any leading digits, which I suspect you can spin up fairly readily yourself)
Function CompareCell(Cell1 as String, Cell2 as String) as Integer
Dim result as integer
Dim suffix1 as string
Dim suffix2 as string
if val(cell1)< val(cell2) Then
result = -1
else if val(cell1)>val(cell2) then
result = 1
else if val(cell1)=val(cell2) then
if len(cell1)=len(cell2) then
result =0
else
' write code to strip leading numeric prefixes
' You must supply StripPrefix, but it's pretty simple
' I just omitted it here for clarity
suffix1=StripPrefix(cell1) ' eg returns "ABC" for "1000ABC"
suffix2=StripPrefix(cell2)
if suffix1 < suffix2 then
result = -1
else if suffix1 > suffix2 then
result = 1
else
result = 0
end if
end if
return result
end function
A function like this then allows you to take any two cell references and compare them directly to make whatever decision you need:
if CompareCell(enteredval,newval)>=0 then
newrow=newrow+1
end if

Bizarre for-next loop skip step behavior in Excel VBA

The following code is exhibiting the following bizarre behavior:
1.) if I set the step to zero it moves from cell to cell just fine, the message box counts out 1 through 8 (For i = 1 to 8 Step 0).
2.) if I set the step to one it gives the sequence 1, 3, 5, 7 (For i = 1 to 8 Step 1). It is my understanding that Step 1 should be producing 1, 2, 3, 4, 5, 6, 7, 8 for the message box return.
Private Sub CommandButton1_Click()
Dim i As Integer
For i = 1 To 8 Step 1
MsgBox i
ActiveCell.Offset(1, 0).Range("A1").Select
i = i + 1
Next i
End Sub
The math of this makes sense of course, but the mechanics according to standard excel looping seems bizarre because this yields the same result as (with no step increment specified):
Private Sub CommandButton1_Click()
Dim i As Integer
For i = 1 To 8
MsgBox i
ActiveCell.Offset(1, 0).Range("A1").Select
i = i + 1
Next i
End Sub
that is the MsgBox sequence is 1, 3, 5, 7. The point is that I know appending "Step 0" to the for statement gives the unitary increments but this feels like a work-around for leaving off the Step increment all together? I have to wonder if my 2013 excel pro plus is corrupted. Please clue me in as to whether this is normal or not. TIA.
But you have this line in the code:
i = i + 1
Which makes it jump double because it's your loop variable too!
So For increments the variable for you, you don't have to do i = i + 1 in the loop. You would have to, if it was a while loop. But never in a For loop, because you're interfering with the loop. (Unless this is your exact intention.)
Folks what can I say? Well a little more actually, if you look at the block of code that I didn't include:
Private Sub CommandButton1_Click()
Dim i As Integer
For i = 1 To 8 Step 0
MsgBox i
ActiveCell.Offset(1, 0).Range("A1").Select
i = i + 1
Next i
End Sub
you might be able to appreciate the value of the "Step 0", this allows the user total control over the incremental step via i = i +1, or more generally for a function f(), i = f(i). Hence not incrementing at the "For i = ..." level may actually have some utility depending on what kind of jam one find's oneself in.
In summary: a.) leaving out the Step modifier is equivalent to the default i.e., Step = 1. b.) zeroing the Step modifier, Step = 0 requires a "do while" approach with explicit incrementing via i = f(i) placed within the loop. Finally, and I'm not going to test this, but with Step = 0 and no increasing incrementing may cause an infinite loop or throw an error depending on the situation (so it is probably a good idea to avoid Step = 0 unless you are sure about your f(i) and it's placement within the loop block!).

Excel if function

I've made this large excel sheet and at the time i didn't know i'd need to sort this table through categories.
I have in a column (J here ) the description of the line and the category joint. (example: "Shipment of tires for usin'ss")
The only way i was able to sort the table the way i wanted was to build a category column using this :
=IF(COUNTIF(J3;"*usi*");"Usins";IF(COUNTIF(J3;"*remis*");"Remise";IF(COUNTIF(J3;"*oe*");"Oenols";IF(COUNTIF(J3;"*KDB*");"KDB";IF(COUNTIF(J3;"*vis*");"cvis";IF(COUNTIF(J3;"*amc*");"AMC";0))))))
usi for instance is a segment of a category name, that i sometimes wrote as
usin'ss
usin
usin's
usins
'cause you know smart.
Anyway, how do i translate =If(If(If...))) into something readable in VBA like:
If...then
If... then
Example of "IF ... ELSE" in EVBA
IF condition_1 THEN
'Instructions inside First IF Block
ELSEIF condition_2 Then
'Instructions inside ELSEIF Block
...
ELSEIF condition_n Then
'Instructions inside nth ELSEIF Block
ELSE
'Instructions inside Else Block
END IF
Example of Case Switch in EVBA
Select Case score
Case Is >= 90
result = "A"
Case Is >= 80
result = "B"
Case Is >= 70
result = "C"
Case Else
result = "Fail"
End Select
Both cases work off a waterfall type logic where if the first condition is met, then it does not continue, but if condition 1 is not met then it checks the next, etc.
Example usage:
Function makeASelectAction(vI_Score As Integer) As String
Select Case vI_Score
Case Is >= 90
makeASelectAction = "A, fantastic!"
Case Is >= 80
makeASelectAction = "B, not to shabby."
Case Is >= 70
makeASelectAction = "C... least your average"
Case Else
makeASelectAction = "Fail, nuff said."
End Select
End Function
Function makeAnIfAction(vS_Destination As String, vS_WhatToSay As String, Optional ovR_WhereToStick As Range, Optional ovI_TheScore As Integer)
If vS_Destination = "popup" Then
MsgBox (vS_WhatToSay)
ElseIf vS_Destination = "cell" Then
ovR_WhereToStick.value = vS_WhatToSay
ElseIf vS_Destination = "select" Then
MsgBox makeASelectAction(ovI_TheScore)
End If
End Function
Sub PopMeUp()
Call makeAnIfAction("popup", "Heyo!")
End Sub
Sub PopMeIn()
Call makeAnIfAction("cell", "Heyo!", Range("A4"))
End Sub
Sub MakeADescision()
Call makeAnIfAction(vS_Destination:="select" _
, vS_WhatToSay:="Heyo!" _
, ovI_TheScore:=80 _
)
End Sub
It will show you how to send variables to functions and how to call said function, it will show you how use optional parameters, how a function and interact with another function or sub, how do write a value to a sheet or spit out a messagebox. The possabilities are endless. Let me know if you need anything else cleared up or coded out.
You seem to be using CountIf just to see if the contents of the cell matches a certain pattern and, if so, give a replacement string. In VBA you can use the Like operator for pattern matching. In any event -- here is a function I wrote which, when passed a string and a series of pattern/substitution strings, loops through the patterns until it finds a match and then returns the corresponding substitution. If no match is found, it returns an optional default value (the last argument supplied). If no default is supplied, it returns #N/A.
The code illustrates that sometimes complicated nested ifs can be replaced by a loop which iterates through the various cases. This is helpful when you don't know the number of cases before hand.
Function ReplacePattern(s As String, ParamArray patterns()) As Variant
Dim i As Long, n As Long
n = UBound(patterns)
If n Mod 2 = 0 Then n = n - 1
For i = 0 To n Step 2
If s Like patterns(i) Then
ReplacePattern = patterns(i + 1)
Exit Function
End If
Next i
If UBound(patterns) Mod 2 = 0 Then
ReplacePattern = patterns(n + 1)
Else
ReplacePattern = CVErr(xlErrNA)
End If
End Function
Your spreadsheet formula is equivalent to
=ReplacePattern(J3,"*usi*","Usins","*remis*","Remise","*oe*","Oenols","*KDB*","KDB","*vis*","cvis","*amc*","AMC",0)

Wait loop on two conditions using VBA

I need the macro to loop if one of the criteria is not met. Working with some basic scraping. I need this to loop until ready before I start gathering data.
If ie.document.getElementsByClassName("clicks").Length < 1 Or ie.document.getElementsByClassName("feedback").Length < 1 Then
Do: Loop
End If
I think it would look like this :
Do While ie.document.getElementsByClassName("clicks").Length >= 1 And ie.document.getElementsByClassName("feedback").Length >= 1
'''code
Loop
Your loop does not check with each iteration, only once and if it is not ready then it will enter an infinite loop. You need a solution that checks each time the loop iterates.
Do
If ie.document.getElementsByClassName("clicks").Length < 1 Or ie.document.getElementsByClassName("feedback").Length < 1 Then
DoEvents 'free the processor to work on other things
Else
Exit Do
End If
Loop
This will check each time the loop iterates rather than just once.

Resources