There is a portion of my macro that tries to take a string and break down the characters into its own array value, as follows:
'matchName As String is called from the Sub parameter
Dim matchArray(1 To 30) As Characters
Dim i As Integer
i = 1
While Mid(matchName, i, 1) <> ""
matchArray(i) = Mid(matchName, i, 1)
i = i + 1
Wend
From what I know, this should run perfectly fine, but I'm running into:
runtime error '91': "Object variable or With block variable not set".
I honestly cannot figure out why this is the case and would love another pair of eyes (or more!) to see if I'm missing something.
Here is how to do it:
Dim matchArray
Dim i As Long
ReDim matchArray(1 To Len(matchName))
For i = 1 To Len(matchName)
matchArray(i) = Mid(matchName, i, 1)
Next
.
And while the above will work perfectly, this is more fun in one line and no loop:
myArray = Evaluate("transpose(mid(""" & matchName & """,row(1:" & Len(matchName) & "),1))")
Related
Dim txt As String
Dim i As Integer
Dim reference As Variant
Dim d As Integer
d = Worksheets("Sheet1").cells(Rows.Count, "a").End(xlUp).Row
txt = cells(3, 4).Value
reference = Split(txt, " ")
For i = 0 To UBound(reference)
cells(d + 1, [4]).Value = reference(i)
Next
txt = cells(3, 4).Value
reference = Split(txt, " ")
cells(d + 1, [12]).Value = reference(3)
Hi, im trying to pick the reference before the ubound value each time, and the copy to the reference to the last line. I got this code to work when its the 4th part of the string but im trying to always pick the value before the ubound. Is it possible to do UBOUND -1. or do i have to go another way around this. thanks max
There are basically 2 ways to pick the prelast value.
Option 1 - Using Ubound():
Sub TestMe()
Dim reference As String
reference = "Stack Overflow is my favourite VBA site!"
Dim splitted As Variant
splitted = Split(reference)
Debug.Print splitted(UBound(splitted) - 1)
End Sub
Option 2 - Using predefined function for array length and removing 2 from it:
Calling it this way:
Debug.Print splitted(GetArrayLength(splitted) - 2)
The function:
Private Function GetArrayLength(myArray As Variant) As Long
If IsEmpty(myArray) Then
GetArrayLength = 0
Else
GetArrayLength = UBound(myArray) - LBound(myArray) + 1
End If
End Function
The function is a bit better, because it checks for empty arrays.
I have a list that was copied from a 'table of contents' page to column D. Unfortunately, each cell contains the chapter number, chapter name, and the page number.
3.14.4 chapter name placeholder.140
Sometimes there is a space between the page number and the last character. other times there is not.
I've tried
Function john(txt As String) As Long
Dim x
x = Split(Trim(txt), Chr(32))
john = Val(x(UBound(x)))
End Function
Which does work but I'd like to be able to apply this to the chapter number as well afterwards.
Private Sub FIND_LAST_NUMBER()
Dim A As String
Dim B As Integer
Dim C As String
Dim D As String
x = 3
Do While ActiveSheet.Cells(x, 4).Value <> ""
A = Range("D" & x).Value
A = Trim(A)
B = Len(A)
For Position = B To 1 Step -1
C = Mid(A, Position, 1)
'MsgBox C
If C <> " " Then
D = Right(A, B - Position)
Range("E" & x).Value = C
GoTo LastLine
'Exit Sub
End If
Next Position
LastLine:
x = x + 1
Loop
End Sub
but I'm trying to figure out how to get all of the number instead of only the last digit of the page number from the original cell
I am obviously not getting something here.
Any tips or tricks will be greatly appreciated
One, admittedly not very beautiful solution I can think of right away would be to use Replace to remove all non-numeric characters.
Dim str As String
str = Replace(str, " ", "") '<- to remove the random spaces
str = LCase(str) '<- making everything lower case
For i = 97 To 122
str = Replace(str, Chr(i), "")
Next i
Chr(i) with i from 97 to 122 will be every Character of the standard Alphabet.
This does not work if special Characters appear in the Chapter Name String. If the Chapter name contains numbers these will remain, but you could detect that case because UBound of the split array will be 1 greater than usual.
Also if you can quickly scan all the cells with your data for other unwanted Characters like - / or whatever might occur, you can also get rid of them with Replace
Performance of this solution might not be great but for a quick fix it might do..
I have a for loop, and inside it i have if statement.
In my Excel I have a list that contains each value one time. Once I found it i don't want the code to even check the conditional, i want it to skip this part of the if statement completely each time the loop is executed, is it possible?
Here is my code and list:
the first iteration of the loop will find that "c" is the value so it will do what inside it (xc = i)
I don't want the code to even check "ElseIf Cells(1, i) = "c" again, like the following image, is this possible?
code as text:
Sub test()
Dim i, xa, xb, xc As Integer
For i = 1 To 5
If Cells(i, 1) = "a" Then
xa = i
ElseIf Cells(i, 1) = "b" Then
xb = i
ElseIf Cells(i, 1) = "c" Then
xc = i
End If
Next i
End Sub
My initial interpretation of your need was "if the code hits 'c' again, just don't act".
To do so, you could modify the logic as follows:
ElseIf (xc = 0) And (Cells(i, 1) = "c") Then
This way, as soon as xc is set, the first boolean expression would be False, and the overall condition would not ever be met again. As mentioned by #TimWilliams, VBA would still evaluate the second boolean expression, unlike other languages that feature short-circuiting options. #Gene's answer describes a way around this. Typically, for better performance, you would evaluate the simple conditions first, before resorting to costly ones.
Additional notes
In VBA, you must give a type to each variable. In your Dim line, only xc is an Integer, while the other variables are Variants.
An unqualified Cells() call operates on the currently active worksheet, which might not be the expected one. Suggestion: qualify Cells() with the CodeName of your worksheet. The CodeName is what you see or specify under a worksheet's (Name) property as seen from the Visual Basic editor. For example, if (Name) is Sheet1, use Sheet1.Cells(). This will only work if the code resides in the same workbook as Sheet1. If the code is behind the worksheet itself, you can even use Me.Cells().
When dealing with cell values as your code does, VBA is (silently) being nice and understands that, among the numerous properties of the Range class, Value is what you are interested in. It is better practice, however, to explicitly state the target property, such as in Sheet1.Cells(i, j).Value.
EDIT
Knowing the values will be distinct and that there are about 60 of them, I suggest you simply use a Dictionary, as shown below, to get each value's row in one go, without a cascade of Ifs:
Option Explicit
Sub test()
Dim i As Integer
Dim dict As Object 'Scripting.Dictionary
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To 5
dict(Cells(i, 1).Value) = i
Next
Debug.Print dict("a") '4
Debug.Print dict("b") '2
Debug.Print dict("c") '1
'Etc.
End Sub
if i understood your question you can try this code:
Sub test()
Dim i, xa, xb, xc As Integer
Dim a, b, c As Boolean
a = False
b = False
c = False
For i = 1 To 5
If Cells(i, 1) = "a" And a <> True Then
xa = i
a = True
ElseIf Cells(i, 1) = "b" And b <> True Then
xb = i
b = True
ElseIf Cells(i, 1) = "c" And c <> True Then
xc = 1
c = True
End If
Next i
End Sub
Boolean variable is setted true for example only when the cells(i,1)="a" and after the next "a" value are skipped...
hope this helps
I just wanted to "mod" Ferdinando's code so it's a bit more "readable", I think. The main (the substantive) difference between this version and Ferdinando's or Excelosaurus' is that the cell is not even tested once the value is detected. Remember that the question was: I don't want the code to even check "ElseIf Cells(1, i) = "c" again... So, this version does exactly that.
Sub test()
Dim i As Integer, xa As Integer, xb As Integer, xc As Integer
Dim aFound As Boolean, bFound As Boolean, cFound As Boolean
Dim r As Range
For i = 1 To 5
Set r = Cells(i, 1)
If Not aFound Then
If r = "a" Then xa = i: aFound = True
ElseIf Not bFound Then
If r = "b" Then xb = i: bFound = True
ElseIf Not cFound Then
If r = "c" Then xc = i: cFound = True
End If
Next i
End Sub
I don't like the idea of 60 ElseIfs. Please examine the code below. In order to test it, create a worksheet called "TestSheet" and enter your A1:A5 to cells H2:H6.
Sub TestSpike()
' 06 Jan 2019
Dim Rng As Range
Dim Items As Variant
Dim Spike As String
Dim Tmp As String
Dim i As Integer
Dim R As Long
Items = Split("c|b|0|a|1", "|")
With Worksheets("TestSheet").Columns("H")
For R = 2 To 6
Tmp = CStr(.Cells(R).Value)
If InStr(1, Spike, Tmp, vbTextCompare) = 0 Then
Spike = Spike & "|" & Tmp
On Error Resume Next
i = Application.WorksheetFunction.Match(Tmp, Items, 0)
If Err Then
MsgBox Tmp & " wasn't found in Array"
Else
MsgBox "i = " & i & " = Item " & Tmp
End If
End If
Next R
End With
End Sub
The code has a "Spike". Each item is first checked against the Spike. If it is found there no further tests are carried out. Else, it is added to the Spike.
New items, after being added to the Spike, are checked against the Array "Items" which would hold your 60 elements, separated by Chr(124) thus, Split("c|b|0|a|1", "|"). I use the worksheet function MATCH to look for the item in the array. The result is an index number (or an error, if not found). You can use this index number in a Select Case statement to process each item distinct from others, basically the same way as you now process it when the If statement returns True.
One idea you may find useful with this kind of setup is to use the index from the Match function to return a value from another array. The other array might, for example, contain function names and you use Application.Run to call a different function for each item. This would run significantly faster than examining 60-odd Select Case statements.
Example
Say I have a string:
"I say ""Hello world"" and she says ""Excuse me?"""
VBA will interpret this string as:
I say "Hello world" and she says "Excuse me?"
A more complex example:
I have a string:
"I say ""Did you know that she said """"Hi there!"""""""
VBA interprets this string as:
I say "Did you know that she said ""Hi there!"""
If we remove "I say "
"Did you know that she said ""Hi there!"""
we can continue parsing the string in vba:
Did you know that she said "Hi there!"
Problem
Ultimately I want some function, sBasicQuote(quotedStringHierarchy as string), which returns a string containing the next level up in the string hierarchy.
E.G.
dim s as string
s = "I say ""Did you know that she said """"Hi there!"""""""
s = sBasicQuote(s) ' returns 'I say "Did you know that she said ""Hi there!"""'
s = sBasicQuote(s) ' returns 'Did you know that she said "Hi there!"'
s = sBasicQuote(s) ' returns 'Hi there!'
I just can't figure out an algorithm that would work with this... You almost need to replace all double quotes, but when you've replaced the nth double quote you have to skip to the n+1th douple quote?
How does one implement this in VBA?
You could do something like this
Public Sub test()
Dim s As String
s = "I say ""Did you know that she said """"Hi there!"""""""
Debug.Print DoubleQuote(s, 0)
Debug.Print DoubleQuote(s, 1)
Debug.Print DoubleQuote(s, 2)
End Sub
Public Function DoubleQuote(strInput As String, intElement As Integer) As String
Dim a() As String
strInput = Replace(strInput, String(2, Chr(34)), String(1, Chr(34)))
a = Split(strInput, chr(34))
DoubleQuote = a(intElement)
End Function
Another slightly modified version is a little more accurate
`Public Function DoubleQuote(strInput As String, intElement As Integer) As String
Dim a() As String
Dim b() As String
Dim i As Integer
ReDim b(0)
a = Split(strInput, Chr(34))
' ***** See comments re using -1 *******
For i = 0 To UBound(a) - 1
If Len(a(i)) = 0 Then
b(UBound(b)) = Chr(34) & a(i + 1) & Chr(34)
i = i + 1
Else
b(UBound(b)) = a(i)
End If
ReDim Preserve b(UBound(b) + 1)
Next i
DoubleQuote = b(intElement)
End Function`
I think the following will return what you are looking for in your nested quote example. Your first example is not really a situation of nested quotes.
Option Explicit
Sub NestedQuotes()
Const s As String = "I say ""Did you know that she said """"Hi there!"""""""
Dim COL As Collection
Dim Start As Long, Length As Long, sTemp As String, V As Variant
Set COL = New Collection
sTemp = s
COL.Add sTemp
Do Until InStr(sTemp, Chr(34)) = 0
sTemp = COL(COL.Count)
sTemp = Replace(sTemp, String(2, Chr(34)), String(1, Chr(34)))
Start = InStr(sTemp, Chr(34)) + 1
Length = InStrRev(sTemp, Chr(34)) - Start
sTemp = Mid(sTemp, Start, Length)
COL.Add sTemp
Loop
For Each V In COL
Debug.Print V
Next V
End Sub
My Solution
I spent some more time thinking and came up with this solution.
Function sMineDoubleQuoteHierarchy(s As String) As String
'Check the number of quotes in the string are even - sanity check
If (Len(s) - Len(Replace(s, """", ""))) Mod 2 <> 0 Then sMineDoubleQuoteHierarchy = "Error - Odd number of quotes found in sMineDoubleQuoteHierarchy() function": Exit Function
'First thing to do is find the first and last *single* quote in the string
Dim lStart, lEnd, i As Long, fs As String
lStart = InStr(1, s, """")
lEnd = InStrRev(s, """")
'After these have been found we need to remove them.
s = Mid(s, lStart + 1, lEnd - lStart - 1)
'Start at the first character
i = 1
Do While True
'Find where the next double quote is
i = InStr(1, s, """""")
'if no double quote is found then concatenate with fs with the remainder of s
If i = 0 Then Exit Do
'Else add on the string up to the char before the ith quote
fs = fs & Left(s, i - 1)
'Replace the ith double quote with a single quote
s = Left(s, i - 1) & Replace(s, """""", """", i, 1)
'Increment by 1 (ensuring the recently converted double quote is no longer a single quote
i = i + 1
Loop
'Return fs
sMineDoubleQuoteHierarchy = s
End Function
What's going on in this solution?
The first part of the process is removing the first and last single quote from the string and returning the text between them. Then we loop through the string replacing each instance of "" and replacing it with ". Each time we do this we skip to the next character to unsure strings like """" go to "" instead of ".
Does anyone else have a better/more compact solution?
Edit
After all the suggestions in this forum I settled with this. It's got some extra error trapping to find validate nested strings.
Public Function DoubleQuoteExtract(ByVal s As String, Optional ByRef ErrorLevel As Boolean) As String
'This effectively parses the string like BASIC does by removing incidents of "" and replacing them with "
'SANITY CHECK - Check even number of quotes
Dim countQuote As Double
countQuote = Len(s) - Len(Replace(s, """", ""))
'Calculate whether or not quote hierarchy is correct:
'"..." - Is okay - Count Quotes = 2 - Count Quotes / 2 = 1
'""..."" - Is not okay - Count Quotes = 4 - Count Quotes / 2 = 2
'"""...""" - Is okay - Count Quotes = 6 - Count Quotes / 2 = 3
'""""..."""" - Is not okay - Count Quotes = 8 - Count Quotes / 2 = 4
'etc.
'Ultimately: IF CountQuotes/2 = Odd The string hierarchy is setup fine
' IF CountQuotes/2 = Even, The string Hierarchy is setup incorrectly.
Dim X As Double: X = countQuote / 2
Dim ceil As Long: ceil = Int(X) - (X - Int(X) > 0)
If ceil Mod 2 <> 0 Then sDoubleQuoteExtract = "#Error - Incorrect number of double quotes forming an incomplete hierarchy.": GoTo ErrorOccurred
'If an odd number of quotes are found then they cannot be paired correctly, thus throw error
If countQuote Mod 2 <> 0 Then sDoubleQuoteExtract = "#Error - Odd number of quotes found in sMineDoubleQuoteHierarchy() function": GoTo ErrorOccurred
'Find the next incident of single quote. Trim the string to this
s = Mid(s, InStr(1, s, String(1, Chr(34))))
'replace all instances of "" with "
s = Replace(s, String(2, Chr(34)), String(1, Chr(34)))
'Finally trim off the first and last quotes
DoubleQuoteExtract = Mid(s, 2, Len(s) - 2)
ErrorLevel = False
Exit Function
ErrorOccurred:
ErrorLevel = True
End Function
I am getting an object defined error with the below code. Any idea what could i be doing wrong? Thanks
Sub Loop_Test2()
Dim i As Integer
Dim j As Integer
Dim CountAll As Integer
Dim CountXL As Integer
ActiveSheet.Range("A1").Activate
CountAll = ActiveSheet.Range("A35")
MsgBox CountAll
For j = 1 To CountAll
i = 1
This is where the error occurs:
CountXL = Cells(i, j).Value
Continued:
MsgBox CountXL
For i = 1 To CountXL + 2
Cells(i + 2, j) = "Row " & i & " Col " & j
Next i
Next j
End Sub
I think it is an incorrect assignment. I'm not familiar with the correct syntax.
Error Details: "Run time error 1004. Application defined or object defined error
Before you edit your question, you was forget to initial your i .So just set the value for i.
In future, you may use Option Explicit at the top of Sub to make sure you declare the variable before using it.
So for your case, just need set i=1, and please declare all the variables as long instead of integer. You may refer here to find out the reason why use long instead of integer.