Sub Driver()
'Highlights driver who have 1 point
Dim driverData ' array variable to hold driver names
driverData = Range("C2:C391").Value
ReDim driverData(390)
MsgBox driverData(3)
Though Range("C2:C391") has values in the worksheet, the array seems to be having only blanks
So, using the MsgBox command, only a blank appears
When you use just ReDim you clober all the contents in the array. You need to use ReDim Preserve to keep elements that are in the array.
That being said, the you can't simply redim a 2D array into a 1D array. You can do this:
Sub test()
Dim driverData As Variant
Dim newArray() As String
driverData = Range("C2:C391").Value
ReDim newArray(1 To UBound(driverData, 1))
For i = 1 To UBound(driverData)
newArray(i) = driverData(i, 1)
Next
MsgBox newArray(3)
End Sub
You can;
Dim driverData as Variant
driverData = Range("C2:C391")
msgbox driverData(3, 1)
(As you have it, you cannot assign a Range.value to an array, and even if you could the ReDim would erase its contents)
Related
I am trying to pass an array to a collection, but I cannot seem to get the collection to populate.
Public Function CreateCol(ws As Worksheet, ary, col As collection)
Dim rng As Range, collect As collection
Dim y, skey, svalue
On Error Resume Next
'populate fund list
For y = LBound(ary) To UBound(ary)
If ary(y) <> "" Then
skey = Trim(ary(y))
svalue = WorksheetFunction.SumIf(ws.Range("A:A"), ary(y), ws.Range("P:P"))
collect.Add svalue, skey
End If
Next y
End Function
As Mat's Mug said, make sure to set the collection to an object reference. One way to do this is to put set collect = new collection before your for loop.
Is there a way to dump every word and their start range and end range into an array or dictionary or etc. without looping?
I already tried the following two methods and they work,
Sub test_1()
Dim wrd As Variant
Dim TxtArray() As String
Dim i As Long
For Each wrd In ActiveDocument.Range.Words
'code to add to add to array her
Next
End Sub
and
Sub test_2()
Dim TxtArray() As String
TxtArray = Split(ActiveDocument.Range.Text)
End Sub
The split method can't give me the option to register the starting and ending range positions of each word, because I may want to highlight them later on; plus when I add words to the dictionary, I eliminate the duplicate ones
Is there a way to dump the Range.Words collection without looping? I tried but it didn't work.
"when I add words to the dictionary, I eliminate the duplicate ones" - you don't have to do that: use an array of ranges as the value for the dictionary, with the word as the key.
For example:
Sub MapWords()
Dim d As New Scripting.Dictionary
Dim wrd As Variant, tmp, ub As Long, txt As String, w
Dim i As Long
For Each wrd In ActiveDocument.Range.Words
txt = Trim(wrd.Text)
If Len(txt) > 1 Then
If Not d.Exists(txt) Then
d.Add txt, GetArray(wrd)
Else
tmp = d(txt)
ub = UBound(tmp) + 1
ReDim Preserve tmp(1 To ub)
Set tmp(ub) = wrd
d(txt) = tmp
End If
End If
Next
'e.g. -
Set w = d("split")(1)
Debug.Print w.Text, w.Start, w.End
End Sub
Function GetArray(wrd)
Dim rv(1 To 1)
Set rv(1) = wrd
GetArray = rv
End Function
I have following code for filling a ListBox
Function fillData()
Dim vList As Variant
Dim ws As Worksheet: Set ws = Worksheets(BD)
With ws
If (IsEmpty(.Range("D2").Value) = False) Then
Dim lastCell As String: lastCell = "D" & .Range("D65536").End(xlUp).Row
vList = ws.Range("D2:" & lastCell).Value
Me.ListBox1.List = vList
End If
Me.ListBox1.ListIndex = -1
End With
Set vList = Nothing
Set ws = Nothing
End Function
Everything works good so far...
but when I left just one row with data this error appears:
I even printed my range with this:
MsgBox "the range is D2:" & celdaFin
this is what I got
and then the error message appears, how to do this work also with one cell??
EDIT: Solution thanks to #Jason and #tospig
Function fillData()
Dim vList As Variant
Dim ws As Worksheet: Set ws = Worksheets(BD)
Me.ListBox1.Clear
With ws
If (IsEmpty(.Range("D2").Value) = False) Then
vList = ws.Range("D2:D" & .Range("D65536").End(xlUp).Row).Value
If IsArray(vList) Then
Me.ListBox1.List = vList
Else
Me.ListBox1.AddItem (vList)
End If
End If
Me.ListBox1.ListIndex = -1
End With
Set vList = Nothing
Set ws = Nothing
End Function
Any time the variant is populated by a range with more than one value, it automatically creates a 2-D array.
The 2-D array should populate the listbox with no issues.
The array is not a 2-D array if there is only one value in the range so you may have to redim the variant manually
You may have to test the array if it is only one value
If it is only one value then
Redim vList(1 to 1, 1 to 1)
vList(1,1) = ws.Range("D2:" & lastCell).Value
The listbox should be able to take the variant at this point
For the same reasons as #Jason_Walker pointed out, if your variant is an array you can check for it using IsArray. If not, you can add it as a single item
If IsArray(vList) Then
Me.ListBox1.List = vList
Else
Me.ListBox1.AddItem = vList
End if
Update
For completeness, #Jason_Walker 's reasons:
"Any time the variant is populated by a range with more than one value, it automatically creates a 2-D array.
The 2-D array should populate the listbox with no issues.
The array is not a 2-D array if there is only one value in the range"
In Sheet1, cell A1 I have the following text: A-B-C-D-E-F
I need to loop through this text and I have written the following code that works fine:
dim w as worksheet
dim s as variant
dim p as integer
set w = Worksheets(1)
p = 0
For Each s In Split(w.Range("A1").Value, "-")
p = p + 1
MsgBox Split(w.Range("A1").Value, "-")(p - 1)
Next s
The above code pops up the Message box showing each of the letters one after the other, as expected.
BUT I am not happy with the repeating of Split(w.Range("A1").Value, "-"), declaring the array for the loop and once again for every occurrence within the loop.
So I have tried with:
MsgBox s.Value
but it throws an error about an object being requested.
Why can I not use the Value property given that "s" is a variant?
Split returns a string array which is separated into individual strings by the For Each, so you can just pass those to MsgBox as is.
So, rather than using s.Value, just use s on its own.
In other words:
dim w as Worksheet
dim s as Variant
set w = Worksheets(1)
For Each s In Split(w.Range("A1").Value, "-")
MsgBox s
Next
You can do this like this
dim w as worksheet
dim s as string
set w = Worksheets(1)
For Each s In Split(w.Range("A1").Value, "-")
MsgBox s
Next
When you assign any object to a variant then it behaves like the object assigned to it and has only those properties which are present in object. In your For Each split you assigned string to s and string variables return their value directly and not by objString.Value.
Can't quite figure out what's going wrong here.
I get a object variable not set for the last debug.print line.
N.B - the debug.print line in the loop prints fine and there are three shaped that should be in the array (and i is at 3 at the end of the loop).
I think I may just not understand exactly how arrays / variable setting works, I'm new to VBA (I do have programming experience though).
Dim allShapes As Shapes
Set allShapes = ActivePresentation.Slides(11).Shapes
Dim textShapes() As Shape
ReDim textShapes(0 To 2)
i = 0
For Each thisShape In allShapes
If thisShape.HasTextFrame Then
If thisShape.TextFrame.HasText Then
Debug.Print thisShape.TextFrame.TextRange.Text
Set textShapes(i) = thisShape
i = i + 1
ReDim textShapes(0 To i) As Shape
End If
End If
Next thisShape
ReDim textShapes(0 To i - 1)
Debug.Print textShapes(1).TextFrame.TextRange.Text
For Each thisShape In allShapes
What is allShapes? Is it declared somewhere?
Also to preserve the shapes in the array you have to use Redim Preserve
Is this what you are trying? This loops thorough all the shapes in Slide 1.
Sub Sample()
Dim textShapes() As Shape, i as Long
ReDim textShapes(0 To 2)
i = 0
For Each thisShape In ActivePresentation.Slides(1).Shapes
If thisShape.HasTextFrame Then
If thisShape.TextFrame.HasText Then
Set textShapes(i) = thisShape
i = i + 1
ReDim Preserve textShapes(0 To i) As Shape
End If
End If
Next thisShape
Debug.Print textShapes(1).TextFrame.TextRange.Text
End Sub
Also as the title of the question say Get all shapes with text; In such a case you will have to loop through the array. to get all shapes with text.