I am writing a code where I have a for loop in which I give a variable (named VType ) some value. For loop goes for a range of i variables. Now I want to make a new variable by concatenating names of both variables. for example if i = 1 then I want to make variable VType1. Here is my piece of code.
nrec = Split(Split(ie.document.body.innerHTML, "Found <strong>")(1), "</strong> records")(0)
If nrec = 1 Then
lnk.Click
Else
For j = 1 To nrec
link.Click
Do While ie.readyState <> 4: Wait 5: Loop
Application.Wait (Now + TimeValue("0:00:01"))
'VType , j = GetType
'Application.Wait (Now + TimeValue("0:00:01"))
IMO , j = GetValue("IMO:")
'MMSI = GetValue("MMSI:")
YBuilt , j = GetValue("Year Built:")
Flag , j = GetValue("Flag:")
DWT , j = GetValue("Deadweight:")
Next j
num = "1 - " & IMO1
For i = 2 To nrec
num = num & vbCrLf & i & "abc"
Next I
fin = InputBox(num, nrec & " records found for a. please select right one.")
Exit For
End If
There is not a way to directly do what you're specifically requesting. However, you can use arrays to get a similar outcome. Arrays are a not a topic that can be explained in a single posted answer, but if you do a little research you can probably figure out how the below might be useful...
Dim VTtyp(0 to i) as string
'while Looping...
Vtype(i) = "Whatever you want stored in this round of i"
When your code completes, you'll have all fields saved as variables that can be called from this array. An example is if you wanted to call the one that was tied to the number "2" you could type: Vtype(2) and it would call the text from the 2 iteration.
Again this example is extremely simplified and there are things to consider such as dim size, changing the dim, preserving the array, etc. and that is something you'll have to research further. However bottom line is, "there is not a way to do what you're specifically trying to do."
You can achieve this using Dictionary objects concept. Go through the below link to know more about dictionary objects.
https://www.tutorialspoint.com/vbscript/vbscript_dictionary_objects.htm
Related
I am very new to VBA, so I apologize if this is a very simple question. I am trying to pass user input data into an array. Actually, 4 different arrays. All 4 arrays can have up to 3 elements, but could only need one at any given time. They are then sorted a specific way via For Loops and then will output the sendkeys function to the active window (which will not be excel when it is running). I have the for loops figured out and it is sorting the way i need it to. I just need to be able to get the user input into those arrays and then output them to a phantom keyboard (i.e. sendkeys). I appreciate any help or advice!
FYI, I have declared the arrays as strings and the variables as long... the message boxes are there to just test the sort, they are not very important
For i = 0 To UBound(SheetPosition)
If j = UBound(Position) Then
j = 0
End If
For j = 0 To UBound(Position)
If k = UBound(Direction) Then
k = 0
End If
For k = 0 To UBound(Direction)
If l = UBound(Temper) Then
l = 0
End If
For l = 0 To UBound(Temper)
MsgBox(i)
MsgBox(SheetPosition(i))
MsgBox(j)
MsgBox(Position(j))
MsgBox(k)
MsgBox(Direction(k))
MsgBox(l)
MsgBox(Temper(l))
Next
Next
Next
Next
you could use Application.InputBox() method in two ways:
Dim myArray As Variant
myArray = Application.InputBox("List the values in the following format: " & vbCrLf & "{val1, val2, val3, ...}", Type:=64) '<--| this returns an array of 'Variant's
myArray = Split(Application.InputBox("List the values in the following format: " & vbCrLf & "val1, val2, val3, ...", Type:=2), ",") '<--| this returns an array of 'String's
Yes, you could get the input from the user using Input boxes:
myValue = InputBox("Give me some input")
Or forms, which is the preferred method. Unfortunately, forms take some time to develop and are best deployed through Excel add-ins, which also require time to learn how to setup.
Here is a good tutorial on using the SendKeys method:
http://www.contextures.com/excelvbasendkeys.html
The usual way of getting data from cells into an array would be:
Dim SheetPosition As Variant
SheetPosition = Range("A1:A3").Value
or perhaps
Dim SheetPosition As Variant
SheetPosition = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
A few things to note:
The array needs to be dimensioned as a Variant.
The dimension of the array will be rows x columns, so in the first example above SheetPosition will be dimensioned 1 To 3, 1 To 1, and in the second example it might be dimensioned 1 To 5721, 1 To 1 (if the last non-empty cell in column A was A5721)
If you need to find the dimensions of a multi-dimensioned array, you should use UBound(SheetPosition, 1) to find the upper bound of the first dimension and UBound(SheetPosition, 2) to find the upper bound of the second dimension.
Even if you include Option Base 0 at the start of your code module, the arrays will still be dimensioned with a lower bound of 1.
If you want a single dimensioned array and your user input is in a column, you can use Application.Transpose to achieve this:
Dim SheetPosition As Variant
SheetPosition = Application.Transpose(Range("A1:A3").Value)
In this case SheetPosition will be dimensioned 1 To 3.
If you want a single dimensioned array and your user input is in a row, you can still use Application.Transpose to achieve this, but you have to use it twice:
Dim SheetPosition As Variant
SheetPosition = Application.Transpose(Application.Transpose(Range("A1:C1").Value))
FWIW - Your If statements in the code in the question are not achieving anything - each of the variables that are being set to 0 are going to be set to 0 by the following For statements anyway. So your existing code could be:
For i = LBound(SheetPosition) To UBound(SheetPosition)
For j = LBound(Position) To UBound(Position)
For k = LBound(Direction) To UBound(Direction)
For l = LBound(Temper) To UBound(Temper)
MsgBox i
MsgBox SheetPosition(i)
MsgBox j
MsgBox Position(j)
MsgBox k
MsgBox Direction(k)
MsgBox l
MsgBox Temper(l)
Next
Next
Next
Next
I have the following code which is supposed to step through an array of fields and create two new arrays to add to a new recordset:
For Each Field In SDSRecordsets(i)
Debug.Print (j)
Debug.Print (Field.Value)
fieldNames(j) = Field.Name
If Field.Value = Null Then
values(j) = ""
Else
values(j) = Field.Value
End If
j = j + 1
Next
The first time this loop runs, the Debug.Print lines print out 0 and then the string value in the first cell as it should. It then runs through the rest of it with no problems. The second time, it tries to add an empty cell. The first Debug.Print prints out 1, as it should, and the second prints out Null, also doing as it should. However, I then get a compile error on the line:
values(j) = Field.Value
Can anyone explain why it is reaching this line, because the way I see it, the If statement must be evaluating Null = Null as false for this to happen.
I've also tried doing this with:
If Not IsEmpty(Field.Value) Then
But that doesn't work either.
Use the Nz function:
For Each Field In SDSRecordsets(i)
Debug.Print (j)
Debug.Print (Field.Value)
fieldNames(j) = Field.Name
values(j) = nz(Field.Value,"")
j = j + 1
Next
Also you can use isnull([expr]) function, the direct comparison with null will not work
I have a macro that changes single quotes in front of a number to an apostrophe (or close single curly quote). Typically when you type something like "the '80s" in word, the apostrophe in front of the "8" faces the wrong way. The macro below works, but it is incredibly slow (like 10 seconds per page). In a regular language (even an interpreted one), this would be a fast procedure. Any insights why it takes so long in VBA on Word 2007? Or if someone has some find+replace skills that can do this without iterating, please let me know.
Sub FixNumericalReverseQuotes()
Dim char As Range
Debug.Print "starting " + CStr(Now)
With Selection
total = .Characters.Count
' Will be looking ahead one character, so we need at least 2 in the selection
If total < 2 Then
Return
End If
For x = 1 To total - 1
a_code = Asc(.Characters(x))
b_code = Asc(.Characters(x + 1))
' We want to convert a single quote in front of a number to an apostrophe
' Trying to use all numerical comparisons to speed this up
If (a_code = 145 Or a_code = 39) And b_code >= 48 And b_code <= 57 Then
.Characters(x) = Chr(146)
End If
Next x
End With
Debug.Print "ending " + CStr(Now)
End Sub
Beside two specified (Why...? and How to do without...?) there is an implied question – how to do proper iteration through Word object collection.
Answer is – to use obj.Next property rather than access by index.
That is, instead of:
For i = 1 to ActiveDocument.Characters.Count
'Do something with ActiveDocument.Characters(i), e.g.:
Debug.Pring ActiveDocument.Characters(i).Text
Next
one should use:
Dim ch as Range: Set ch = ActiveDocument.Characters(1)
Do
'Do something with ch, e.g.:
Debug.Print ch.Text
Set ch = ch.Next 'Note iterating
Loop Until ch is Nothing
Timing: 00:03:30 vs. 00:00:06, more than 3 minutes vs. 6 seconds.
Found on Google, link lost, sorry. Confirmed by personal exploration.
Modified version of #Comintern's "Array method":
Sub FixNumericalReverseQuotes()
Dim chars() As Byte
chars = StrConv(Selection.Text, vbFromUnicode)
Dim pos As Long
For pos = 0 To UBound(chars) - 1
If (chars(pos) = 145 Or chars(pos) = 39) _
And (chars(pos + 1) >= 48 And chars(pos + 1) <= 57) Then
' Make the change directly in the selection so track changes is sensible.
' I have to use 213 instead of 146 for reasons I don't understand--
' probably has to do with encoding on Mac, but anyway, this shows the change.
Selection.Characters(pos + 1) = Chr(213)
End If
Next pos
End Sub
Maybe this?
Sub FixNumQuotes()
Dim MyArr As Variant, MyString As String, X As Long, Z As Long
Debug.Print "starting " + CStr(Now)
For Z = 145 To 146
MyArr = Split(Selection.Text, Chr(Z))
For X = LBound(MyArr) To UBound(MyArr)
If IsNumeric(Left(MyArr(X), 1)) Then MyArr(X) = "'" & MyArr(X)
Next
MyString = Join(MyArr, Chr(Z))
Selection.Text = MyString
Next
Selection.Text = Replace(Replace(Selection.Text, Chr(146) & "'", "'"), Chr(145) & "'", "'")
Debug.Print "ending " + CStr(Now)
End Sub
I am not 100% sure on your criteria, I have made both an open and close single quote a ' but you can change that quite easily if you want.
It splits the string to an array on chr(145), checks the first char of each element for a numeric and prefixes it with a single quote if found.
Then it joins the array back to a string on chr(145) then repeats the whole things for chr(146). Finally it looks through the string for an occurence of a single quote AND either of those curled quotes next to each other (because that has to be something we just created) and replaces them with just the single quote we want. This leaves any occurence not next to a number intact.
This final replacement part is the bit you would change if you want something other than ' as the character.
I have been struggling with this for days now. My attempted solution was to use a regular expression on document.text. Then, using the matches in a document.range(start,end), replace the text. This preserves formatting.
The problem is that the start and end in the range do not match the index into text. I think I have found the discrepancy - hidden in the range are field codes (in my case they were hyperlinks). In addition, document.text has a bunch of BEL codes that are easy to strip out. If you loop through a range using the character method, append the characters to a string and print it you will see the field codes that don't show up if you use the .text method.
Amazingly you can get the field codes in document.text if you turn on "show field codes" in one of a number of ways. Unfortunately, that version is not exactly the same as what the range/characters shows - the document.text has just the field code, the range/characters has the field code and the field value. Therefore you can never get the character indices to match.
I have a working version where instead of using range(start,end), I do something like:
Set matchRange = doc.Range.Characters(myMatches(j).FirstIndex + 1)
matchRange.Collapse (wdCollapseStart)
Call matchRange.MoveEnd(WdUnits.wdCharacter, myMatches(j).Length)
matchRange.text = Replacement
As I say, this works but the first statement is dreadfully slow - it appears that Word is iterating through all of the characters to get to the correct point. In doing so, it doesn't seem to count the field codes, so we get to the correct point.
Bottom line, I have not been able to come up with a good way to match the indexing of the document.text string to an equivalent range(start,end) that is not a performance disaster.
Ideas welcome, and thanks.
This is a problem begging for regular expressions. Resolving the .Characters calls that many times is probably what is killing you in performance.
I'd do something like this:
Public Sub FixNumericalReverseQuotesFast()
Dim expression As RegExp
Set expression = New RegExp
Dim buffer As String
buffer = Selection.Range.Text
expression.Global = True
expression.MultiLine = True
expression.Pattern = "[" & Chr$(145) & Chr$(39) & "]\d"
Dim matches As MatchCollection
Set matches = expression.Execute(buffer)
Dim found As Match
For Each found In matches
buffer = Replace(buffer, found, Chr$(146) & Right$(found, 1))
Next
Selection.Range.Text = buffer
End Sub
NOTE: Requires a reference to Microsoft VBScript Regular Expressions 5.5 (or late binding).
EDIT:
The solution without using the Regular Expressions library is still avoiding working with Ranges. This can easily be converted to working with a byte array instead:
Sub FixNumericalReverseQuotes()
Dim chars() As Byte
chars = StrConv(Selection.Text, vbFromUnicode)
Dim pos As Long
For pos = 0 To UBound(chars) - 1
If (chars(pos) = 145 Or chars(pos) = 39) _
And (chars(pos + 1) >= 48 And chars(pos + 1) <= 57) Then
chars(pos) = 146
End If
Next pos
Selection.Text = StrConv(chars, vbUnicode)
End Sub
Benchmarks (100 iterations, 3 pages of text with 100 "hits" per page):
Regex method: 1.4375 seconds
Array method: 2.765625 seconds
OP method: (Ended task after 23 minutes)
About half as fast as the Regex, but still roughly 10ms per page.
EDIT 2: Apparently the methods above are not format safe, so method 3:
Sub FixNumericalReverseQuotesVThree()
Dim full_text As Range
Dim cached As Long
Set full_text = ActiveDocument.Range
full_text.Find.ClearFormatting
full_text.Find.MatchWildcards = True
cached = full_text.End
Do While full_text.Find.Execute("[" & Chr$(145) & Chr$(39) & "][0-9]")
full_text.End = full_text.Start + 2
full_text.Characters(1) = Chr$(96)
full_text.Start = full_text.Start + 1
full_text.End = cached
Loop
End Sub
Again, slower than both the above methods, but still runs reasonably fast (on the order of ms).
I have problem skipping some specific part of the code while execution.
Dim turn as Integer = 1
Function recurs1()
If turn = 9 Then
GoTo Endline
End If
For i = 0 To 5
For j = 0 To 5
If (arr(i, j) <> 10 And arr(i, j) <> 20) Then
If chance Mod 2 = 1 Then
MsgBox("Intialized (" & i & "," & j & ") To 10") 'Line X
arr(i, j) = 10
ElseIf chance Mod 2 = 0 Then
MsgBox("Intialized (" & i & "," & j & ") To 20") 'Line Y
arr(i, j) = 20
End If
turn += 1 'Updating turn
recurs1() 'Recursion takes place here
End If
Next
Next
Endline:
Return Nothing
End Function
According to my understanding, the code should stop assigning values to the array after value of turn hits 9 and should return flow to the calling function/sub. However, it continues to assign values and Line X or Line Y are printed depending on the value of turn.
If allowed, the value of turn increments up to 37.
I'd surely appreciate some help with this problem from someone with a deeper understanding of the code than me.
Thank you very much.
You have placed the recursive call inside two for loops. The function will be called recursively until turn = 9, but when it returns it's still in the loop where it will be increased anyway without further checks.
Probably it would work better if you checked the value of turn just before calling the recursive function (this way you get rid of GoTo, also).
Why not just put Return Nothing where you have Goto Endline? Return stops function execution, to the best of my knowledge. That would get rid of the dreaded Goto command (it can cause messy code and inscrutable bugs).
I am really new with vba, so please forgive my slaughtering of the code. I'm trying to write a macro for excel (my first one), and I get "statement invalid outside of type block" (pointing at the first line). Here is my code:
Sub MakeHTMLTable()
Worksheets("Sheet1").Activate
endRow As Integer
For Count = 1 To 200
For CountY = 1 To 200
If (!ActiveSheet.Cells(Count, CountY).Value.IsEmpty) Then
ActiveSheet.Cells(Count, CountY).Value = "<td>" + ActiveSheet.Cells(Count, CountY).Value + "</td>"
End If
Exit For
Exit For
For i = 1 To 200
If (!ActiveSheet.Cells(i, 1).Value.IsEmpty()) Then
ActiveSheet.Cells(i, 1).Value = "<tr>" + ActiveSheet.Cells(i, 1)
End If
Exit For
For x = 1 To 200
If (!ActiveSheet.Cells(x, 1).Value.IsEmpty()) Then
endRow = x
End If
Exit For
For countAgain = 1 To 200
If (!ActiveSheet.Cells(x, countAgain).Value.IsEmpty()) Then
ActiveSheet.Cells(x, countAgain).Value = ActiveSheet.Cells(x, countAgain).Value + "</tr>"
End If
Exit For
End Sub
I really don't understand, as the debugger fails on the line of computer generated code without even making it to mine. Have I missed ending an If" or For block?
I also realize that I'm probably reinventing the wheel. Any help on more appropriate built in functions would be appreciated.
It looks like you've got quite a few syntax errors in your code.
In VBA, local variables are declared with the Dim keyword.
So, the endRow declaration should look like this:
Dim endRow As Integer
For loops should end with the Next statement. So, your For loops should look like this:
For x = 1 To 200
If (!ActiveSheet.Cells(x, 1).Value.IsEmpty()) Then
endRow = x
End If
Next
VBA uses the keyword Not instead of !, so, your conditionals should look like this:
If (Not (ActiveSheet.Cells(i, 1).Value.IsEmpty())) ...
Try removing most of the code and adding it back in line-by-line until all of it works. The VBA syntax can be cumbersome for those who aren't used to it.