I am currently working on a project for my job. I have two Subs and want to fill an array with one of those and want to use it in the other Sub. Its hard to explain but here is the code so far:
Private Sub Find_CHNO(name As String, ByRef Myarray() As String)
Dim filter As String
Dim ws As Worksheet
Dim rng As Range
Dim i, j As Long
Set ws = Sheets("Stoffdatenbank")
Set rng = ws.Range("A1").CurrentRegion
filter = name
ReDim Myarray(4)
For i = 1 To rng.Rows.count
If InStr(1, rng.Cells(i, 2), filter) > 0 Then
For j = 1 To 4
Myarray(j) = rng.Cells(i, j + 2)
Next
End If
Next
End Sub
And
Private Sub b_heizwert_calculate_Click()
Dim wC, wH, wN, wO, Hi As Double
Dim arr1(0 To 4), arr2(0 To 4), arr3(0 To 4) As String
If arrL3(0) = "" Then
Call Find_CHNO(arrL1(0), arr1)
Call Find_CHNO(arrL2(0), arr2)
MsgBox arr1(0)
'wC = arrL1(1) * arr1(1)
Else
End If
End Sub
Whenever I press on the Button that triggers the second Sub I get the following error:
Compile Error: Incompatible Type: Data field or user-defined type expected
The following is marked blue when the error occurs: The "arr1" in the following line:
Call Find_CHNO(arrL1(0), arr1)
When you Dim arr1(0 To 4), arr2(0 To 4), arr3(0 To 4) As String only the last is a string array. The first two are variant arrays.
Define each definitively.
Dim arr1(0 To 4) As String, arr2(0 To 4) As String, arr3(0 To 4) As String
You are also defining arr1, arr2 and arr3 but using arrL1, arrL2 and arrL3 but I'll assume that is just a typo or they are publicly declared elsewhere.
Related
Fairly new to Arrays (im trying to speed up a currently slow workbook that uses ranges)
lets say I start out with a table like this (Located in Range "A1:B5" on my worksheet)
and im trying to filter it to only intact (this is a simplified version of what im trying to do irl), why am I getting a Type Mismatch and my output array highlighting?
Public Sub Manager_Report()
'Declare Variables
Dim main_array As Variant Dim output_array As Variant
'Populate Main Array
main_array = range("A1").CurrentRegion
'Filter the Array for intact
output_array = Filter(main_array, "Intact")
End Sub
Option Explicit
Option Base 1
Sub OutputFilterArray()
Dim INarray
Dim OutArray
Dim OutArrayFinal
Dim I As Long
Dim CNT As Long
Dim N As Integer
INarray = Range("A3:d" & Range("d" & Rows.Count).End(xlUp).Row).Value
CNT = 1
ReDim OutArray(UBound(INarray, 1), UBound(INarray, 2))
For I = 1 To UBound(INarray, 1)
If INarray(I, 1) = "Intact" Then
For N = 1 To UBound(INarray, 2)
OutArray(CNT, N) = INarray(I, N)
Next N
CNT = CNT + 1
End If
Next I
Range("F3").Resize(UBound(OutArray, 1), UBound(OutArray, 2)) = OutArray
End Sub
I have 2 arrays taken from 2 ranges in a sheet. I'm trying to create a third array that contains only the values contained in array 1 that are missing in array 2 (I found this code online).
Array 2´s size will vary and depends on this code:
Dim iListaIncompleta() As Variant
Dim iCountLI As Long
Dim iElementLI As Long
iCountLI = Range("B1").End(xlDown).Row
ReDim iListaIncompleta(iCountLI)
For iElementLI = 1 To iCountLI
iListaIncompleta(iElementLI - 1) = Cells(iElementLI, 2).Value
Next iElementLI
and Array 1's size is always from A1:A7, and I use this code to create it:
Dim iListaCompleta() As Variant
Dim iElementLC As Long
iListaCompleta = Range("A1:A7")
This is the original code I found online to extract missing values:
Dim v1 As Variant, v2 As Variant, v3 As Variant
Dim coll As Collection
Dim i As Long
'Original Arrays from the code:
v1 = Array("Bob", "Alice", "Thor", "Anna") 'Complete list
v2 = Array("Bob", "Thor") 'Incomplete list
Set coll = New Collection
For i = LBound(v1) To UBound(v1)
If v1(i) <> 0 Then
coll.Add v1(i), v1(i) 'Does not add value if it's 0
End If
Next i
For i = LBound(v2) To UBound(v2)
On Error Resume Next
coll.Add v2(i), v2(i)
If Err.Number <> 0 Then
coll.Remove v2(i)
End If
If coll.Exists(v2(i)) Then
coll.Remove v2(i)
End If
On Error GoTo 0
Next i
ReDim v3(LBound(v1) To (coll.Count) - 1)
For i = LBound(v3) To UBound(v3)
v3(i) = coll(i + 1) 'Collections are 1-based
Debug.Print v3(i)
Next i
End Sub
However, this code has arrays defined like this:
v1 = Array("Bob", "Alice", "Thor", "Anna")
And the actual arrays I wanna use are defined differently (as you can see in the first two pieces of code). When I try to run the code with them, it displays
Error 9: Subscript out of range.
The code works well as it originally is, but when I try to use MY arrays, it's when I get this error.
Obviously, I've tried it changing the names of the variables (v1 and v2) to my own 2 arrays (iListaCompleta and iListaIncompleta), and still doesn't work.
Any ideas??
Thank you in advance!
Here's a function that can be used to compare arrays of any dimension size to pull out differences and put only the differences in a one-dimensional array:
Public Function ArrayDifference(ByVal arg_Array1 As Variant, ByVal arg_array2 As Variant) As Variant
If Not IsArray(arg_Array1) Or Not IsArray(arg_array2) Then Exit Function 'Arguments provided were not arrays
Dim vElement As Variant
Dim hDifference As Object: Set hDifference = CreateObject("Scripting.Dictionary")
For Each vElement In arg_Array1
If Not hDifference.exists(vElement) Then hDifference.Add vElement, vElement
Next vElement
For Each vElement In arg_array2
If hDifference.exists(vElement) Then
hDifference.Remove vElement
Else
hDifference.Add vElement, vElement
End If
Next vElement
ArrayDifference = hDifference.Keys
End Function
Here's how you would call the function to compare two different arrays. It also includes how to populate the initial arrays using your provided setup:
Sub arrays()
Dim ws As Worksheet: Set ws = ActiveWorkbook.ActiveSheet
Dim rList1 As Range: Set rList1 = ws.Range("A1", ws.Cells(ws.Rows.Count, "A").End(xlUp))
Dim rList2 As Range: Set rList2 = ws.Range("B1", ws.Cells(ws.Rows.Count, "B").End(xlUp))
Dim aList1 As Variant
If rList1.Cells.Count = 1 Then
ReDim aList1(1 To 1, 1 To 1)
aList1(1, 1) = rList1.Value
Else
aList1 = rList1.Value
End If
Dim aList2 As Variant
If rList2.Cells.Count = 1 Then
ReDim aList2(1 To 1, 1 To 1)
aList2(1, 1) = rList2.Value
Else
aList2 = rList2.Value
End If
Dim aList3 As Variant
aList3 = ArrayDifference(aList1, aList2)
MsgBox Join(aList3, Chr(10))
End Sub
I'm trying to copy multiple non-adjacent (non-contiguous) excel columns to an array but it's not working. Below is what I've tried...
Public Function Test()
Dim sh As Worksheet: Set sh = Application.Sheets("MyWorksheet")
Dim lr As Long: lr = sh.Cells(sh.Rows.Count, 1).End(xlUp).row
Dim r1 As Range: Set r1 = sh.Range("A1:A" & lr)
Dim r2 As Range: Set r2 = sh.Range("C1:C" & lr)
Dim rAll As Range: Set rAll = Union(r1, r2)
'Dim arr() As Variant: arr = Application.Transpose(rAll) <-- Throws Type mismatch error
'Dim arr As Variant: arr = Application.Transpose(rAll) <-- arr Value = Error 2015
Dim arr() As Variant: arr = rAll.Value2 ' <-- Only the first column (col A) is loaded.
End Function
Any help is greatly appreciated!
Since reading multiple values into an array like arr = rAll.Value2 is only possible in continous ranges, you have to alternatives:
Alternative 1:
Write a function that reads the range values area wise and merge it into one array.
Option Explicit
Public Function NonContinousColumnsToArray(ByVal NonContinousRange As Range) As Variant
Dim iArea As Long
For iArea = 1 To NonContinousRange.Areas.Count - 1
If NonContinousRange.Areas.Item(iArea).Rows.CountLarge <> NonContinousRange.Areas.Item(iArea + 1).Rows.CountLarge Then
MsgBox "Different amount of rows is not allowed.", vbCritical, "NonContinousColumnsToArray"
Exit Function
End If
Next iArea
Dim ArrOutput() As Variant
ArrOutput = NonContinousRange.Value2 'read first area into array
'read all other areas
For iArea = 2 To NonContinousRange.Areas.Count
ReDim Preserve ArrOutput(1 To UBound(ArrOutput, 1), 1 To UBound(ArrOutput, 2) + NonContinousRange.Areas.Item(iArea).Columns.CountLarge) As Variant 'resize array
Dim ArrTemp() As Variant 'read arrea at once into temp array
ArrTemp = NonContinousRange.Areas.Item(iArea).Value2
'merge temp array into output array
Dim iCol As Long
For iCol = 1 To UBound(ArrTemp, 2)
Dim iRow As Long
For iRow = 1 To UBound(ArrTemp, 1)
ArrOutput(iRow, UBound(ArrOutput, 2) - UBound(ArrTemp, 2) + iCol) = ArrTemp(iRow, iCol)
Next iRow
Next iCol
Next iArea
NonContinousColumnsToArray = ArrOutput
End Function
So the following example procedure
Public Sub ExampleTest()
Dim InputRng As Range
Set InputRng = Union(Range("A1:A9"), Range("C1:D9"))
Dim OutputArr() As Variant
OutputArr = NonContinousColumnsToArray(InputRng)
Range("A12").Resize(UBound(OutputArr, 1), UBound(OutputArr, 2)).Value = OutputArr
End Sub
would take the following non-continous range Union(Range("A1:A9"), Range("C1:D9")) as input,
Image 1: The input range was non-continous A1:A9 and C1:D9.
merge it into one array OutputArr and write the values as follows
Image 2: The merged output array written back into cells.
Alterantive 2: Using a temporary worksheet …
… to paste the values as continous range, which then can be read into an array at once.
Public Sub ExampleTestTempSheet()
Dim InputRng As Range
Set InputRng = Union(Range("A1:A9"), Range("C1:D9"))
Dim OutputArr() As Variant
OutputArr = NonContinousColumnsToArrayViaTempSheet(InputRng)
Range("A12").Resize(UBound(OutputArr, 1), UBound(OutputArr, 2)).Value = OutputArr
End Sub
Public Function NonContinousColumnsToArrayViaTempSheet(ByVal NonContinousRange As Range) As Variant
On Error Resume Next
NonContinousRange.Copy
If Err.Number <> 0 Then
MsgBox "Different amount of rows is not allowed.", vbCritical, "NonContinousColumnsToArray"
Exit Function
End If
On Error GoTo 0
Dim TempSheet As Worksheet
Set TempSheet = ThisWorkbook.Worksheets.Add
TempSheet.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
NonContinousColumnsToArrayViaTempSheet = TempSheet.UsedRange.Value2
Dim ResetDisplayAlerts As Boolean
ResetDisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
TempSheet.Delete
Application.DisplayAlerts = ResetDisplayAlerts
End Function
Note that the alternative 2 is more likely to fail, because of the temporary worksheet. I think alternative 1 is more robust.
Alternative solution via Application.Index() function
Just for fun an alternative solution allowing even a resorted column order A,D,C:
Sub ExampleCall()
'[0]define range
With Sheet1 ' reference the project's source sheet Code(Name), e.g. Sheet1
Dim lr As Long: lr = .Cells(.Rows.Count, 1).End(xlUp).Row
Dim rng As Range: Set rng = .Range("A1:D" & lr)
End With
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'[1]get data in defined columns order A,C,D
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim data: data = RearrangeCols(rng, "A,D,C")
'[2]write to any target range
Sheet2.Range("F1").Resize(UBound(data), UBound(data, 2)) = data
End Sub
Help functions called by above main procedure
Function RearrangeCols(rng As Range, ByVal ColumnList As String)
'Purpose: return rearranged column values based on ColumnList, e.g. Columns A,C,D instead of A:D
'[a]assign data to variant array
Dim v: v = rng
'[b]rearrange columns
v = Application.Index(v, Evaluate("row(1:" & UBound(v) & ")"), GetColNums(ColumnList)) ' Array(1, 3, 4)
'[c]return rearranged array values as function result
RearrangeCols = v
End Function
Function GetColNums(ByVal ColumnList As String, Optional ByVal Delim As String = ",") As Variant()
'Purpose: return array of column numbers based on argument ColumnList, e.g. "A,C,D" ~> Array(1, 3, 4)
'[a]create 1-dim array based on string argument ColumnList via splitting
Dim cols: cols = Split(ColumnList, Delim)
'[b]get the column numbers
ReDim tmp(0 To UBound(cols))
Dim i: For i = 0 To UBound(tmp): tmp(i) = Range(cols(i) & ":" & cols(i)).Column: Next
'[c]return function result
GetColNums = tmp
End Function
Further solution //Edit as of 2020-06-11
For the sake of completeness I demonstrate a further solution based on an array of arrays (here: data) using the rather unknown double zero argument in the Application.Index() function (see section [2]b):
data = Application.Transpose(Application.Index(data, 0, 0))
Sub FurtherSolution()
'[0]define range
With Sheet1 ' reference the project's source sheet Code(Name), e.g. Sheet1
Dim lr As Long: lr = .Cells(.Rows.Count, 1).End(xlUp).Row
Dim rng As Range: Set rng = .Range("A1:D" & lr)
End With
'[1]assign data to variant array
Dim v: v = rng
'[2]rearrange columns
'a) define "flat" 1-dim array with 1-dim column data A,C,D (omitting B!)
Dim data
data = Array(aCol(v, 1), aCol(v, 3), aCol(v, 4))
'=====================
'b) create 2-dim array
'---------------------
data = Application.Transpose(Application.Index(data, 0, 0))
'[3]write to any target range
Sheet2.Range("F1").Resize(UBound(data), UBound(data, 2)) = data
End Sub
Function aCol(DataArr, ByVal colNo As Long) As Variant()
'Purpose: return entire column data as "flat" 1-dim array
With Application
aCol = .Transpose(.Index(DataArr, 0, colNo))
End With
End Function
Caveat: This 2nd approach seems to be less performant for greater data sets.
Related link
Some pecularities of the Application.Index() function
Thank you PEH,
Great explanation which led me to the following solution:
Function Test()
Dim sh as Worksheet : set sh = Sheets("MySheet")
Dim lr as Long : lr = sh.Cells(sh.Rows.Count, 1).End(xlUp).row
Dim arr () as Variant
Dim idx as Long
' Delete unwanted columns to ensure contiguous columns...
sh.Columns("B:B").Delete
' Load Array
arr = Sheet("MySheet").Range("A1:B" & lr).value2
' This allows speedy index finds... Note, index(arr, startrow, keycol)
' Will need to use "On Error" to handle key not being found
idx = WorksheetFunction.match("MyKey", WorksheetFunction.Index(arr, 0, 2), 0)
' And then fast processing through the array
For idx = idx to lr
if (arr(idx, 2) <> "MyKey") then exit for
' do some processing...
Next idx
End Function
Thank you again!
The idea behind using arrays is to increase speed. Moving and deleting columns, as well as "for" looping slows you down.
I'm looking for a way to speed up one of my procedures from 120,000 µs to 60,000 or less.
The proposed solutions slow it down to 450,000.
Goal: populate 1-D array from 2 columns (in 2 different files) without looping.
The code where I'm trying to read the first list to an array fails on the line
MergeAccountOpportArr = NamesRng.Value
Attempted code:
Option Explicit
Public AccountsWB As Workbook
Public AccountsSht As Worksheet
' --- Columns Variables ---
Public Const NamesCol As String = "F"
' --- Public Arrays ---
Public MergeAccountOpportArr() As String
'===================================================================
Sub MergeRangestoArray()
Dim OpportWBName As String, AccountsWBName As String, WebinarWBName As String
Dim NamesRng As Rang
Dim LastRow As Long, i As Long
ReDim MergeAccountOpportArr(100000) 'init size array to very large size >> will optimize later
' open Accounts file
AccountsWBName = GetFileName(ThisWorkbook.Path, "Accounts")
' set the Accounts file workbook object
Set AccountsWB = Workbooks.Open(Filename:=AccountsWBName, ReadOnly:=True)
' set the worksheet object
Set AccountsSht = AccountsWB.Worksheets(1)
With AccountsSht
LastRow = FindLastRow(AccountsSht) ' get last row
Set NamesRng = .Range(.Cells(1, NamesCol), .Cells(LastRow, NamesCol))
MergeAccountOpportArr = NamesRng.Value ' <---- Here comes the error
End With
' rest of my code
End Sub
In theory, you should be able to do this by hacking around with the SAFEARRAY structures in memory. The indexing of the data area for a SAFEARRAY is determined by the product of the indexes of the individual dimensions, so if you have a two dimensional array where one dimension only has a single element, the memory addresses should be the same for a one dimensional array (row * 1 = row).
As proof of concept...
YOU CAN TRY THIS AT HOME KIDS, BUT THIS IS NOT PRODUCTION GRADE CODE.
'In declarations section:
#If VBA7 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, _
ByVal length As Long)
#Else
Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, _
ByVal length As Long)
#End If
Private Const VT_BY_REF = &H4000&
Private Type SafeBound
cElements As Long
lLbound As Long
End Type
Private Type SafeArray
cDim As Integer
fFeature As Integer
cbElements As Long
cLocks As Long
#If VBA7 Then
pvData As LongPtr
#Else
pvData As Long
#End If
rgsabound As SafeBound
rgsabound2 As SafeBound
End Type
Public Function RangeToOneDimensionalArray(Target As Range) As Variant()
If Target.Columns.Count > 1 Or Target.Rows.Count = 1 Then
Err.Raise 5 'Invalid procedure call or argument
End If
Dim values() As Variant
values = Target.Value
If HackDimensions(values) Then
RangeToOneDimensionalArray = values
End If
End Function
Private Function HackDimensions(SafeArray As Variant) As Boolean
Dim vtype As Integer
'First 2 bytes are the VARENUM.
CopyMemory vtype, SafeArray, 2
Dim lp As Long
'Get the data pointer.
CopyMemory lp, ByVal VarPtr(SafeArray) + 8, 4
'Make sure the VARENUM is a pointer.
If (vtype And VT_BY_REF) <> 0 Then
'Dereference it for the actual data address.
CopyMemory lp, ByVal lp, 4
Dim victim As SafeArray
CopyMemory ByVal VarPtr(victim), ByVal lp, LenB(victim)
'Set the dimensions to 1
victim.cDim = 1
'Set the bound on the first dimension.
victim.rgsabound.cElements = victim.rgsabound2.cElements
CopyMemory ByVal lp, ByVal VarPtr(victim), LenB(victim)
HackDimensions = True
End If
End Function
Note that this has to swap the 2 dimensions (and the declarations are limited to 2D arrays). It also leaves the second dimension rgsabound "hanging", so you'll likely leak the memory for that structure (8 bytes) every time you run this.
The safer way would be to copy the contents of the memory area onto a new one dimensional array and use that instead, OR wrap this whole mess in a Class module and clean up after yourself when you get done.
Oh yeah, it works ;-)
Public Sub Testing()
Dim sample() As Variant
sample = RangeToOneDimensionalArray(Sheet1.Range("A1:A30"))
Dim idx As Long
For idx = 1 To 30
Debug.Print sample(idx)
Next
End Sub
This converts the ranges into a strings delimited by a specified character. It then joins the two lists into an array with split()
Note:
Delimiter will have to be a character not in your dataset
Transpose is due to your data being in columns. If your data is in rows you'll have to check it, maybe with something like a column count.
.
Sub Test()
Dim oResultArray() As String
oResultArray = MergeRngToArray(Sheet1.Range("B3:B12"), Sheet2.Range("B2:B6"))
End Sub
Private Function MergeRngToArray(ByVal Range1 As Range, ByVal Range2 As Range, Optional Delimiter As String = ",") As String()
Dim sRange1 As String
Dim sRange2 As String
sRange1 = Join(Application.WorksheetFunction.Transpose(Range1.Value), Delimiter) & Delimiter
sRange2 = Join(Application.WorksheetFunction.Transpose(Range2.Value), Delimiter)
MergeRngToArray = Split(sRange1 & sRange2, Delimiter)
End Function
Start with the easier problem of copying cells into a 1D array
You can go from a 1D array to a range easily with the following trick:
Public Sub TESTING()
Dim keyarr() As Variant
keyarr = Array("1", "2", "3", "4", "5")
Range("D3").Resize(5, 1).Value = WorksheetFunction.Transpose(keyarr)
End Sub
But the opposite is much harder because the .Value property of a range always returns a 2D array.
Except when used with the transpose function:
Public Sub TESTING()
Dim i As Long, n As Long
Dim keyarr() As Variant
n = Range(Range("B3"), Range("B3").End(xlDown)).Rows.Count
keyarr = WorksheetFunction.Transpose(Range("B3").Resize(n, 1).Value)
' keyarr is a n×1 1D array
' Proof:
For i = 1 To n
Debug.Print keyarr(i)
Next i
End Sub
The trick is a) use the .Transpose() function to make a column into a single row and b) to use an array of Variant and not String. Internally the array will store strings, but the type has to be Variant.
Now the last problem is to combine two arrays
The only solution I can think of is to combine the data into a different worksheet.
Public Sub TESTING()
Dim i As Long, n1 As Long, n2 As Long
Dim vals1() As Variant, vals2() As Variant
' Pull two sets of data from two columns. You could use different sheets if you wanted.
n1 = Range(Range("B3"), Range("B3").End(xlDown)).Rows.Count
vals1 = WorksheetFunction.Transpose(Range("B3").Resize(n1, 1).Value)
n2 = Range(Range("D3"), Range("D3").End(xlDown)).Rows.Count
vals2 = WorksheetFunction.Transpose(Range("D3").Resize(n2, 1).Value)
Sheet2.Range("A1").Resize(n1, 1).Value = WorksheetFunction.Transpose(vals1)
Sheet2.Range("A1").Offset(n1, 0).Resize(n2, 1).Value = WorksheetFunction.Transpose(vals2)
Dim keyarr() As Variant
keyarr = WorksheetFunction.Transpose(Sheet2.Range("A1").Resize(n1 + n2, 1).Value)
End Sub
Array approach
Sub JoinColumnArrays(a, b)
'Purpose: join 2 vertical 1-based 2-dim datafield arrays based on two range columns
'Note: returns 2-dim array with only 1 column
'Hint: overcomes ReDim Preserve restriction to change only the last dimension!
a = Application.Index(a, Evaluate("row(1:" & UBound(a) + UBound(b) & ")"), 0)
Dim i As Long, Start As Long: Start = UBound(a) - UBound(b)
For i = 1 To UBound(b)
a(Start + i, 1) = b(i, 1) ' fills empty a elements with b elements
Next i
End Sub
The above array approach returns a 1-based 2-dim array (of only 1 "column" as 2nd dimension) with changed UBound(a) value, i.e. the sum of the original "row" count of array a plus elements count of array b.
Note that using the Application.Index() function overcomes the restriction of ReDim Preserve which only would change an array's last dimension.
Example Call
'...
Dim a as Variant, b as Variant
dim ws1 as Worksheet, ws2 as Worksheet
' Set ws1 = ... ' << change worksheet definitions to your needs
' Set ws2 = ...
a = ws1.Range("A2:B4") ' assign column data from different sheets
b = ws2.Range("C2:C3")
JoinColumnArrays a, b ' << call procedure JoinColumnArrays
'Debug.Print "column ~>" & Join(Application.Transpose(Application.Index(a, 0, 1)), ", ")
Let's say I have something like "1-34-52", I want to split them into an array, however, while Test1 works, it gives me an String() type array. How do I put the numbers in "1-34-52" into a Long() type array? Can I redim type of an array in VBA?
Sub Test1()
Dim arr As Variant
arr = Split("1-34-52", "-")
Debug.Print TypeName(arr), TypeName(arr(0))
End Sub
Sub Test2()
Dim arr() As Long
arr = Split("1-34-52") 'You get type mismatch error
End Sub
You can Redim an array of Variants. Since Variants can hold integer values, there is no problem:
Sub dural()
ary = Split("1-34-52", "-")
ReDim lary(0 To UBound(ary))
For i = 0 To UBound(ary)
lary(i) = CLng(ary(i))
Next i
End Sub
Note:
Sub dural()
ary = Split("1-34-52", "-")
Dim lary() As Long
ReDim lary(0 To UBound(ary))
For i = 0 To UBound(ary)
lary(i) = CLng(ary(i))
Next i
End Sub
will also work.
You can loop through the array and populate a new one:
Sub Test1()
Dim arr As Variant, LongArr() As Long, X As Long
arr = Split("1-34-52", "-")
ReDim LongArr(UBound(arr))
For X = LBound(arr) To UBound(arr)
LongArr(X) = CLng(arr(X))
Next
Debug.Print TypeName(arr), TypeName(arr(0))
Debug.Print TypeName(LongArr), TypeName(LongArr(0))
End Sub