I am trying to create a loop to have Excel tell a DOS based system to search for a condition. If it doesn't find the condition I get stuck in an infinite loop. I have found many situations where a loop will go until it meets a condition. But is there a way to have it run until the condition is met OR an integer reaches a point? I am VERY new to VBA, so take my lack of knowledge lightly please.
I have tried several of the single condition guides, and purchased VBA for dummies, (not a great deal of help)
Sub Test ()
DOS.readscreen StrLoop 3, 1, 4
Do Until StrLoop = "TXT"
Loop
End Sub
I'm hoping to have an integer count to a certain point and if it reaches a point have it exit the loop. I am just uncertain of how to do it.
Dim StrLoop as string, i as long
Do
DOS.readscreen StrLoop 3, 1, 4
i = i + 1
Loop Until StrLoop = "TXT" or i = 1000
You need to change the variable strloop , until get to a value
dim i as long
Do Until StrLoop = "TXT" or i = 1000
DOS.readscreen StrLoop 3, 1, 4
i = i + 1
Loop
Related
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.
I'm quite stuck with a fairly simple task but I'm not entirely sure how to make this function. I have a simple string as seen below:
{
"0":{"variable1":"ABC1","variable2":"AA","variable3":"BB"},
"5":{"variable1":"ABC2","variable2":"AA","variable3":"BB"},
"3":{"variable1":"BC3","variable2":"AA","variable3":"BB"},
"1":{"variable1":"DC4","variable2":"AA","variable3":"BB"},
"4":{"variable1":"DD5","variable2":"AA","variable3":"BB"}
}
What I'm trying to do, in VB.NET, is to create a loop that finds each line and arranges those first numbers "0", "1", etc. in order depending on what line it is on then simply replaces whatever number is in it, with the correct order number.
In simple:
1) Find how many number of lines the string has. Let's say 20 lines for example.
2) Find and replace each number within "": starting point of the lines in order 1-20 for this example.
Output would look like if used the example at the top:
{
"2":{"variable1":"ABC1","variable2":"AA","variable3":"BB"}, //"2" because it is the second line within the string
"3":{"variable1":"ABC2","variable2":"AA","variable3":"BB"},
"4":{"variable1":"BC3","variable2":"AA","variable3":"BB"},
"5":{"variable1":"DC4","variable2":"AA","variable3":"BB"},
"6":{"variable1":"DD5","variable2":"AA","variable3":"BB"}
}
Any ideas for a quick fix?
The question may be a case of "I have X and I need Y" where X is the item which needs attention.
If the string really is as you presented it, then
Imports System.Text
Module Module1
Sub Main()
Dim s = "{
""0"":{""variable1"":""ABC1"",""variable2"":""AA"",""variable3"":""BB""},
""5"":{""variable1"":""ABC2"",""variable2"":""AA"",""variable3"":""BB""},
""3"":{""variable1"":""BC3"",""variable2"":""AA"",""variable3"":""BB""},
""1"":{""variable1"":""DC4"",""variable2"":""AA"",""variable3"":""BB""},
""4"":{""variable1"":""DD5"",""variable2"":""AA"",""variable3"":""BB""}
}"
Dim t = s.Split({vbCrLf}, StringSplitOptions.None)
Dim u As New StringBuilder
For i = 0 To t.Length - 1
If t(i).StartsWith("""") Then
Dim parts = t(i).Split({":"c}, 2)
If parts.Count = 2 Then
u.AppendLine($"""{i + 1}"":{parts(1)}")
End If
Else
u.AppendLine(t(i))
End If
Next
Console.WriteLine(u.ToString().TrimEnd())
Console.ReadLine()
End Sub
End Module
outputs:
{
"2":{"variable1":"ABC1","variable2":"AA","variable3":"BB"},
"3":{"variable1":"ABC2","variable2":"AA","variable3":"BB"},
"4":{"variable1":"BC3","variable2":"AA","variable3":"BB"},
"5":{"variable1":"DC4","variable2":"AA","variable3":"BB"},
"6":{"variable1":"DD5","variable2":"AA","variable3":"BB"}
}
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
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!).
I have a function that takes optional arguments in pairs: firstRange_1, secondRange_2; firstRange_2, secondRange_2; etc.
For each optional argument I need to execute a series of statements if the argument is passed to the function.
For example
dim firstRange_1 as range
dim secondRange_1 as range
dim firstRange_2 as range
dim secondRange_2 as range
etc.
dim firstCell_1 as string
dim lastCell_1 as string
dim firstCell_2 as string
dim lastCell_2 as string
etc.
If IsMissing(firstRange_1) = False Then
firstCell_1 = secondRange_1.Cells(1,1).Address
lastCell_1 = secondRange_1.Cells(secondRange_1.Rows.Count, secondRange_1.Rows.Count)
End if
if IsMissing(firstRange_2) = False Then
firstCell_2 = secondRange_2.Cells(1,1).Address
lastCell_2 = secondRange_2.Cells(secondRange_2.Rows.Count, secondRange_2.Rows.Count)
End If
Is it possible to "build" (sorry if the terminology isn't correct, I'm not yet experienced in programming or vba) the variables on the fly?
for example a loop like
For n=1 to 100
If IsMissing(firstRange_ & "n") = False Then
firstCell_ & "n" = secondRange_ & "n".Cells(1,1).Address
lastCell_ & "n" = secondRange_ & "n".Cells(secondRange_ & "n".Rows.Count, secondRange_ & "n".Rows.Count)
End If
Next
Edit:
See my comments to Branislav Kollár for updates.
I think what you need to rewrite the function to use ParamArrays (see the "Using an Indefinite Number of Arguments" section). Something like this:
myFunction(ParamArray userRanges()) As Range'or whatever Data Types you need
This way, you could use the LBound and UBound functions to see how many arguments were passed into function, leaving the necessity to check if they are missing.
For example you can create a 2 new arrays inside the function (not the argument array) for determining the first and last cells of each argument range. This is not the only way, you can use 2D arrays or put everything into one array. This is just one way.
Function myFunction(ParamArray userRanges()) As Range
Dim firstCell() As Range
Dim lastCell() As Range
ReDim firstCell(UBound(userRanges))
ReDim lastCell(UBound(userRanges))
For x = 0 To UBound(userRanges)
Set firstCell(x) = userRanges(x).Range("A1")
Set lastCell(x) = firstCell_1(x).Offset(userRanges(x).Rows.Count - 1, userRanges(x).Columns.Count - 1)
Next x
'other code to actually do something with the cells
'...
End Function
Try this, if you have any trouble, please let us know.
One more link to learn about this Understanding the ParamArray
Edit 1
Based on comment from OP, I rewritten the code, so that now each input range userRanges will have firstCell and lastCell stored in appropriate arrays. I didn't realize the limitation of my previous post before.
The only think to keed in mind now, is that the index 0 is first range; 1 is second range; 2 is third range; etc.
Or you can use Option Base 1 to make it more naturally indexed, but that is not recommended for some reason.
You can't dynamically name variables, but you can use Arrays. They are stupid powerful, so it's worth learning about them.
Essentially you will make 2 arrays. One for your input (variable1_n) and one of your outputs (output_1_n).
Dim inputArray(1 to 100) as String 'or whatever type these are supposed to be
Dim outputArray(1 to 100) as Range 'perhaps these are ranges?
For i = 1 to 100
Set outputArray(i) = function(inputArray(i))
Next i
Now you have an array full of ranges!