Summing Multi-Dimension Arrays - Excel VBA - arrays

I am trying to sum a multi-dimensional array in VBA.
What I currently have
My goal is to have the sum of MyArray(2,2) = 121, and of MyArray(3,1) = 129, all of this stored in "MyNewArray".
I tried using Application.Worksheetfunction.Sum but I guess this wouldn't work unless I printed my values to Excel.
Any ideas of how I could go about it?
Appreciate your help.

You need to loop through all the elements of the vector that interests you and sum up the values one by one. It looks cumbersome but it's very fast.
Private Sub Test()
Dim Arr As Variant
Dim i As Long
Dim Sum As Double
ReDim Arr(1 To 5, 1 To 2, 1 To 9)
Arr(2, 2, 2) = 1
Arr(2, 2, 3) = 120
Arr(3, 1, 4) = 1
Arr(3, 1, 6) = 59
Arr(3, 1, 7) = 69
For i = LBound(Arr, 3) To UBound(Arr, 3)
Sum = Sum + Arr(3, 1, i)
Next i
MsgBox "Total = " & Sum
End Sub

Related

Combining Multiple Arrays in VBA

I am currently trying to combine 46 arrays in to a single array. I have scoured the internet, to no prevail and am hoping someone here can help. I did find the below page, but I need to be able to look through each element of the new array in a nested for loop, so using the method below doesn't quite get me to my end goal.
Excel vba - combine multiple arrays into one
Basically, I need to combine my set of 46 arrays in such a way that I can then loop through each element using a nested for loop. ie.
Set of arrays:
myArray1 = (1, 2, 3, 4)
myArray2 = (5, 6, 7)
myArray3 = (8, 9)
myArray4 = (10, 11, 12, 13, 14)
.
.
.
myArray46 = (101, 102, 103)
Combine them to form new array:
myNewArray = (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14... 101, 102, 103)
Loop through in nested for loop to check each element against my main array:
For i = LBound(mainArray) to UBound(mainArray)
For j = LBound(myArray) to UBound(myArray)
If mainArray(i) = myArray(j) Then
'do something
End If
Next j
Next i
Any help and/ or guidance with this is greatly appreciated!
Since you write in your comments that your end goal is to create an array of unique elements, you might be best served using a dictionary, where you can test for uniqueness as you add each element to dictionary. Something like:
Option Explicit
Function uniqueArr(ParamArray myArr() As Variant) As Variant()
Dim dict As Object
Dim V As Variant, W As Variant
Dim I As Long
Set dict = CreateObject("Scripting.Dictionary")
For Each V In myArr 'loop through each myArr
For Each W In V 'loop through the contents of each myArr
If Not dict.exists(W) Then dict.Add W, W
Next W
Next V
uniqueArr = dict.keys
End Function
Sub tester()
Dim myArray1, myArray2, myArray3, myArray4, myArray5
myArray1 = Array(1, 2, 3, 4)
myArray2 = Array(5, 6, 7, 8)
myArray3 = Array(9, 10, 11, 12, 13, 14)
myArray4 = Array(15, 16)
myArray5 = Array(1, 3, 25, 100)
Dim mainArray
mainArray = uniqueArr(myArray1, myArray2, myArray3, myArray4, myArray5)
End Sub
If you run Tester, you will see mainArray contains:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
25
100
Using your data this is how to create one array out of many:
Public Sub TestMe()
Dim myA, myB, myC, myD, myE
myA = Array(1, 2, 3, 4)
myB = Array(5, 6, 7)
myC = Array(8, 9)
myD = Array(10, 11, 12, 13, 14)
myE = Array(101, 102, 103)
Dim myCombine As Variant
Dim myNew() As Variant
Dim myElement As Variant
Dim myArr As Variant
Dim cnt As Long
myCombine = Array(myA, myB, myC, myD, myE)
For Each myArr In myCombine
For Each myElement In myArr
ReDim Preserve myNew(cnt)
myNew(cnt) = myElement
cnt = cnt + 1
Next
Next
For cnt = LBound(myNew) To UBound(myNew)
Debug.Print myNew(cnt)
Next cnt
End Sub
The "building" of the new array is facilitated through ReDim Preserve, which keeps the old values in the array whenver the dimension of the array changes. And if you want to do something with these arrays, you may use 3 nested loops (a bit slow) and have some check:
Dim cnt2 As Long
For cnt = LBound(myNew) To UBound(myNew)
For cnt2 = LBound(myCombine) To UBound(myCombine)
For Each myElement In myCombine(cnt2)
If myElement = myNew(cnt) Then
Debug.Print myElement & vbTab & " from " & vbTab & cnt2
End If
Next myElement
Next cnt2
Next cnt
This is what you get on the immediate window:
1 from 0
2 from 0
3 from 0
4 from 0
5 from 1
6 from 1
7 from 1
8 from 2
9 from 2
10 from 3
11 from 3
12 from 3
13 from 3
14 from 3
101 from 4
102 from 4
103 from 4
Alternate 'brick-by-brick' approach.
Option Explicit
Sub combineArrays()
Dim myArray1 As Variant, myArray2 As Variant, myArray3 As Variant
Dim myArray4 As Variant, myArray46 As Variant
ReDim mainArray(0) As Variant
myArray1 = Array(1, 2, 3, 4)
myArray2 = Array(5, 6, 7)
myArray3 = Array(8, 9)
myArray4 = Array(10, 11, 12, 13, 14)
'...
myArray46 = Array(101, 102, 103)
mainArray = buildMainArray(myArray1, mainArray)
mainArray = buildMainArray(myArray2, mainArray)
mainArray = buildMainArray(myArray3, mainArray)
mainArray = buildMainArray(myArray4, mainArray)
mainArray = buildMainArray(myArray46, mainArray)
ReDim Preserve mainArray(UBound(mainArray) - 1)
Debug.Print Join(mainArray, ",")
End Sub
Function buildMainArray(arr As Variant, marr As Variant)
Dim i As Long
For i = LBound(arr) To UBound(arr)
marr(UBound(marr)) = arr(i)
ReDim Preserve marr(UBound(marr) + 1)
Next i
buildMainArray = marr
End Function
The issue with using Redim Preserve to combine arrays is it can be an expensive operation, since you're basically re-creating the array everytime it's called. Since you have 46 arrays you're combining, you may very well be waiting a while.
Instead, you can loop over the arrays to figure out the total number of elements you need, dimension out your master array, then loop over the arrays again to do the actual assignment/merging. Something like this:
' encapsulates code to determine length of an individual array
' note that because arrays can have different LBounds in VBA, we can't simply use
' Ubound to determine array length
Public Function GetArrayLength(anArray As Variant) As Integer
If Not IsArray(anArray) Then
GetArrayLength = -1
Else
GetArrayLength = UBound(anArray) - LBound(anArray) + 1
End If
End Function
Public Function CombineArrays(ParamArray arraysToMerge() As Variant) As Variant
' index for looping over the arraysToMerge array of arrays,
' and then each item in each array
Dim i As Integer, j As Integer
' variable to store where we are in the combined array
Dim combinedArrayIndex As Integer
' variable to hold the number of elements in the final combined array
Dim CombinedArrayLength As Integer
' we don't initialize the array with an array-length until later,
' when we know how long it needs to be.
Dim combinedArray() As Variant
' we have to loop over the arrays twice:
' First, to figure out the total number of elements in the combined array
' second, to actually assign the values
' otherwise, we'd be using Redim Preserve, which can get quite expensive
' because we're creating a new array everytime we use it.
CombinedArrayLength = 0
For i = LBound(arraysToMerge) To UBound(arraysToMerge)
CombinedArrayLength = CombinedArrayLength + GetArrayLength(arraysToMerge(i))
Next i
' now that we know how long the combined array has to be,
' we can properly initialize it.
' you can also use the commented code instead, if you prefer 1-based arrays.
ReDim combinedArray(0 To CombinedArrayLength - 1)
' Redim combinedArray(1 to CombinedArrayLength)
' now that the combinedarray is set up to store all the values in the arrays,
' we can begin actual assignment
combinedArrayIndex = LBound(combinedArray)
For i = LBound(arraysToMerge) To UBound(arraysToMerge)
For j = LBound(arraysToMerge(i)) To UBound(arraysToMerge(i))
combinedArray(combinedArrayIndex) = arraysToMerge(i)(j)
combinedArrayIndex = combinedArrayIndex + 1
Next j
Next i
' assign the function to the master array we've been using
CombineArrays = combinedArray
End Function
To use this function, you'd do something like the following:
Public Sub TestArrayMerge()
Dim myArray1() As Variant
Dim myArray2() As Variant
Dim myArray3() As Variant
Dim myArray4() As Variant
Dim combinedArray As Variant
myArray1 = Array(1, 2, 3, 4)
myArray2 = Array(5, 6, 7)
myArray3 = Array(8, 9)
myArray4 = Array(10, 11, 12, 13, 14)
combinedArray = CombineArrays(myArray1, myArray2, myArray3, myArray4)
If IsArray(combinedArray) Then
Debug.Print Join(combinedArray, ",")
End If
End Sub
Regarding your last bit, that you're using an inner loop to combine the values in your final combined array: Your inner loop doesn't need to start at LBound(myArray). For any value of i, you've already compared it to the elements before it (e.g., when i = 2, it's already been compared to the first element). So you really just need:
For i = LBound(combinedArray) To UBound(combinedArray) - 1
For j = i + 1 To UBound(combinedArray)
' do whatever you need
Next j
Next i
Perhaps this ...
'To determine if a multi-dimension array is allocated (or empty)
'Works for any-dimension arrays, even one-dimension arrays
Public Function isArrayAllocated(ByVal aArray As Variant) As Boolean
On Error Resume Next
isArrayAllocated = IsArray(aArray) And Not IsError(LBound(aArray, 1)) And LBound(aArray, 1) <= UBound(aArray, 1)
Err.Clear: On Error GoTo 0
End Function
'To determine the number of items within any-dimension array
'Returns 0 when array is empty, and -1 if there is an error
Public Function itemsInArray(ByVal aArray As Variant) As Long
Dim item As Variant, UBoundCount As Long
UBoundCount = -1
If IsArray(aArray) Then
UBoundCount = 0
If isArrayAllocated(aArray) Then
For Each item In aArray
UBoundCount = UBoundCount + 1
Next item
End If
End If
itemsInArray = UBoundCount
End Function
'To determine the number of dimensions of an array
'Returns -1 if there is an error
Public Function nbrDimensions(ByVal aArray As Variant) As Long
Dim x As Long, tmpVal As Long
If Not IsArray(aArray) Then
nbrDimensions = -1
Exit Function
End If
On Error GoTo finalDimension
For x = 1 To 65536 'Maximum number of dimensions (size limit) for an array that will work with worksheets under Excel VBA
tmpVal = LBound(aArray, x)
Next x
finalDimension:
nbrDimensions = x - 1
Err.Clear: On Error GoTo 0
End Function
'****************************************************************************************************
' To merge an indefinite number of one-dimension arrays together into a single one-dimension array
' Usage: mergeOneDimArrays(arr1, arr2, arr3, ...)
' Returns an empty array if there is an error
' Option Base 0
'****************************************************************************************************
Public Function mergeOneDimArrays(ParamArray infArrays() As Variant) As Variant
Dim x As Long, y As Long, UBoundCount As Long, newUBoundCount As Long
Dim tmpArr As Variant, allArraysOK As Boolean
UBoundCount = 0
allArraysOK = True
For x = LBound(infArrays) To UBound(infArrays)
If Not IsArray(infArrays(x)) Or Not nbrDimensions(infArrays(x)) = 1 Then
allArraysOK = False
Exit For
End If
UBoundCount = UBoundCount + itemsInArray(infArrays(x))
Next x
If allArraysOK Then
ReDim tmpArr(0 To UBoundCount - 1)
UBoundCount = 0
For x = LBound(infArrays) To UBound(infArrays)
For y = LBound(infArrays(x)) To UBound(infArrays(x))
tmpArr(UBoundCount) = infArrays(x)(y)
UBoundCount = UBoundCount + 1
Next y
Next x
newUBoundCount = itemsInArray(tmpArr)
If newUBoundCount = UBoundCount Then
mergeOneDimArrays = tmpArr
Else
mergeOneDimArrays = Array()
End If
Erase tmpArr
Else
mergeOneDimArrays = Array()
End If
End Function
If you are working with one-dimensional arrays you could use a collection instead. It is much better at handling dynamic sizing.
You can declare a collection and then add each of the elements in the arrays to it. Then you will have one large list with all of the values.
Dim coll As New Collection
coll.Add MyArray(j)
Here is a good to collections introduction:
https://excelmacromastery.com/excel-vba-collections/

vba multiD array to range

I'm having an issue with writing an 4D Array to a range in Excel.
My Array Looks like this:
varArray(0)
- varArray(0)(0) "test01"
- varArray(0)(1) "test02"
- varArray(0)(2) "test03"
- varArray(0)(3) "test04"
varArray(1)
- varArray(1)(0) "test11"
- varArray(1)(1) "test12"
- varArray(1)(2) "test13"
- varArray(1)(3) "test14"
There will be more than only 2 "Items" in the Array in the end but for understanding I displayded 2 of them.
I tried it with transpose but I coudl not Access the subitems
Range("A" & CellIndex) = Application.Transpose(varArray(0,1))
does not work :S
Output should look like this(write in to a range):
A B C D
1 test01 test02 test03 test04
2 test11 test12 test13 test14
Can anyone assist me on this?
You can use Application.Transpose twice. This will output to the worksheet in columns A:D
Sub CreateArray()
Dim varArray As Variant
varArray = Array(Array(1, 2, 3, 4), Array(11, 12, 13, 14))
For i = 0 To 1
ThisWorkbook.Worksheets("Sheet1").Range("A1:D1").Offset(i, 0).Value = Application.Transpose(Application.Transpose(varArray(i)))
Next i
End Sub
Try:
Dim varArray(0 To 1, 0 To 3) As String
varArray(0, 0) = "test01"
varArray(0, 1) = "test02"
varArray(0, 2) = "test03"
varArray(0, 3) = "test04"
varArray(1, 0) = "test11"
varArray(1, 1) = "test12"
varArray(1, 2) = "test13"
varArray(1, 3) = "test14"
Range("A1:D2") = varArray()
Range("F1:G4") = Application.Transpose(varArray())
I think the output you want is simply your array, not your transposed array. However I put the two outputs on the code. Feel free to change the adresses...
Do you want something like this:
Option Explicit
Public Sub TestMe()
Dim varArray As Variant
Dim lCounter As Long
Dim lCounter2 As Long
Dim rngCell As Range
varArray = Array(Array(1, 2, 3, 4), Array(11, 12, 13, 14))
Set rngCell = Cells(1, 1)
For lCounter = LBound(varArray) To UBound(varArray)
For lCounter2 = LBound(varArray(lCounter)) To UBound(varArray(lCounter))
Debug.Print varArray(lCounter)(lCounter2)
rngCell = varArray(lCounter)(lCounter2)
Set rngCell = rngCell.Offset(0, 1)
Next lCounter2
Debug.Print "-----------"
Set rngCell = Cells(rngCell.Row + 1, 1)
Next lCounter
End Sub
The result in the immediate window is this one:
1
2
3
4
-----------
11
12
13
14
-----------
From this output, you can easily come to your desired one.
You're trying to transpose a single item in the array:
Application.Transpose(varArray(0,1))
Also, this array isn't indexed in such a manner. You could have varArray(0)(1), but you don't have varArray(0,1).
Try this:
Dim x as Long
For x = LBound(varArray) To UBound(varArray)
Range("A1").Resize(1, UBound(varArray(x)) + 1).Offset(x) = Application.Transpose(Application.Transpose(varArray(x)))
Next

VBA counting multiple duplicates in array

I've done some search and tried new codes since last night but haven't yet found the answer I was looking for.
I'm working with multiple arrays but am only looking for duplicates in one array at a time. Having duplicates across different arrays doesn't matter; only duplicates within a single array matters.
Each array has between 5 and 7 elements.
Each element is an integer between 1 and 10.
Some sample arrays can be
Array1 = (5, 6, 10, 4, 2)
Array2 = (1, 1, 9, 2, 5)
Array3 = (6, 3, 3, 3, 6)
Array4 = (1, 2, 3, 3, 3, 3, 2)
etc.
For each array, I would like to know how many duplicates there are. That is,
For Array1, I would like a resulting array of (1) indicating there is no duplicate and each element is unique. DuplicateCount (Array1) = (1).
For Array2, the resulting array should (2, 1) indicating there are 2 duplicates of 1 and the rest of the elemets are unique. DuplicateCount (Array2) = (2, 1).
For Array3, I would like a resulting array of (3, 2) indicating there are 3 duplicates of 3 and 2 duplicates of 6. DuplicateCount (Array3) = (3, 2).
For array 4, I would like a resulting array of (4, 2, 1) as there are 4 duplicates of 3, 2 duplicates of 2, and 1 unique 1. DuplicateCount (Array4) = (4, 2, 1).
I really appreciate all your help.
Thanks.
I think a dictionary might be a good solution for you, because it can store each unique number of array as key and their count as value. If the number exists in the dictionary, then its count will be incremented. Here's my implementation:
Function DuplicateCount(nums As Variant) As Scripting.Dictionary
Dim dict As New Scripting.Dictionary
For Each num In nums
If dict.Exists(num) Then
dict(num) = dict(num) + 1
Else
dict(num) = 1
End If
Next
Set DuplicateCount = dict
End Function
Before using the above code in your application, please ensure that the reference Microsoft Scripting Runtime is enabled (go to Tools -> References and check its box). Now you're ready to go, you can see the full script here:
Sub Main()
Dim array1() As Variant: array1 = Array(5, 6, 10, 4, 2)
Dim array2() As Variant: array2 = Array(1, 1, 9, 2, 5)
Dim array3() As Variant: array3 = Array(6, 3, 3, 3, 6)
Dim array4() As Variant: array4 = Array(1, 2, 3, 3, 3, 3, 2)
Dim result1 As New Scripting.Dictionary
Dim result2 As New Scripting.Dictionary
Dim result3 As New Scripting.Dictionary
Dim result4 As New Scripting.Dictionary
Set result1 = DuplicateCount(array1)
Set result2 = DuplicateCount(array2)
Set result3 = DuplicateCount(array3)
Set result4 = DuplicateCount(array4)
For Each k In result1.Keys()
If result1(k) > 1 Then
'(Nothing)
Debug.Print k & "," & result1(k)
End If
Next
Debug.Print
For Each k In result2.Keys()
If result2(k) > 1 Then
'1,2
Debug.Print k & "," & result2(k)
End If
Next
Debug.Print
For Each k In result3.Keys()
If result3(k) > 1 Then
'6,2
'3,3
Debug.Print k & "," & result3(k)
End If
Next
Debug.Print
For Each k In result4.Keys()
If result4(k) > 1 Then
'2,2
'3,4
Debug.Print k & "," & result4(k)
End If
Next
End Sub
Function DuplicateCount(nums As Variant) As Scripting.Dictionary
Dim dict As New Scripting.Dictionary
For Each num In nums
If dict.Exists(num) Then
dict(num) = dict(num) + 1
Else
dict(num) = 1
End If
Next
'Debug: Enable the below lines to print the key-value pairs
'For Each k In dict.Keys()
' Debug.Print k & "," & dict(k)
'Next
Set DuplicateCount = dict
End Function
Sub tester()
Debug.Print Join(RepCount(Array(5, 6, 10, 4, 2)), ",")
Debug.Print Join(RepCount(Array(1, 2, 3, 3, 3, 3, 2)), ",")
Debug.Print Join(RepCount(Array(6, 3, 3, 3, 6)), ",")
Debug.Print Join(RepCount(Array(6, 6, 3, 3, 3, 6)), ",")
End Sub
Function RepCount(arrIn)
Dim rv(), rv2(), i, m, mp, n
ReDim rv(1 To Application.Max(arrIn))
ReDim rv2(0 To UBound(rv) - 1)
For i = 0 To UBound(arrIn)
rv(arrIn(i)) = rv(arrIn(i)) + 1
Next i
For i = 1 To UBound(rv)
m = Application.Large(rv, i) 'i'th largest rep count
If IsError(m) Then Exit For 'error=no more reps
If m <> mp Then 'different from the previous
rv2(n) = m
n = n + 1
End If
mp = m
Next i
ReDim Preserve rv2(0 To n - 1) 'size array to fit content
RepCount = rv2
End Function

Sort array and return initial index VBA

So this might be an easy one but I just couldn't work my head around it.I am working on VBA.
I have the following array:
temp=(9,4,9,3,8,4,9,8)
and i want to sort it but instead of returning
temp=(9,9,9,8,8,4,4,3)
i want it to return the index of the value like
temp=(1,3,7,5,8,2,6,4).
Any help is appreciated. Thank you in advance!
Try this:
Sub Tester()
Dim arr, v, i, arr2()
arr = Array(9, 4, 9, 3, 8, 4, 9, 8)
ReDim arr2(LBound(arr) To UBound(arr))
Debug.Print "Original", Join(arr, ",")
For i = LBound(arr2) To UBound(arr2)
arr2(i) = Application.Large(arr, i + 1)
Next i
Debug.Print "Sorted", Join(arr2, ",")
For i = LBound(arr2) To UBound(arr2)
v = Application.Match(arr2(i), arr, 0)
arr2(i) = v 'save the position
arr(v - 1) = vbNull 'remove the found value
Next i
Debug.Print "Positions", Join(arr2, ",")
End Sub
EDIT: without the intermediate sort
Sub Tester2()
Dim arr, v, i, arr2()
arr = Array(9, 4, 9, 3, 8, 4, 9, 8)
ReDim arr2(LBound(arr) To UBound(arr))
For i = LBound(arr) To UBound(arr)
v = Application.Match(Application.Large(arr, 1), arr, 0)
arr(v - 1) = vbNull
arr2(i) = v
Next i
Debug.Print "Positions", Join(arr2, ",")
End Sub
Here is another algo using only native VBA functions, i.e. no Excel functions such as Application.Match etc., which should be much faster for large arrays. Takes about 5 seconds for an array of ca. 9000 elements. It returns the array of indices sort_idx as well as the array of sorted values arr_sorted. Note: the array here is 2D with any number of rows and 1 column, taken from column A on sheet "1". Can be easily adapted for a 1D array.
Sub cost_min()
'Get data
arr = Range(Sheets("1").Range("A1"), Sheets("1").Range("A1").End(xlDown)).Value2
'Sort price curve & get indices
Dim sort_idx(), arr_sorted()
ReDim sort_idx(1 To UBound(arr)), arr_sorted(1 To UBound(arr))
arr_2 = arr 'create copy to edit while sorting
For i = 1 To UBound(arr)
'Get max, record idx & value
max_val = arr_2(1, 1)
j = 1
sort_idx(i) = j
arr_sorted(i) = max_val
For j = 1 To UBound(arr_2)
If arr_2(j, 1) > max_val Then
max_val = arr_2(j, 1)
sort_idx(i) = j
arr_sorted(i) = max_val
End If
Next j
'Replace max found with null
arr_2(sort_idx(i), 1) = vbNull
Next i
End Sub

Excel Macro Multi Dimension Array Value Deleted after IF function

I met with some problem with Excel Macro.
I am trying too copy values from various cells of a worksheet into an array for use of comparing with other worksheet's cell value later.
However, I am stuck at the array to store all the value I am trying to assign to it.
Below is the code piece I have done.
Sub singleEntry(suppRow As Integer)
Dim j As Integer
Dim myArray() As Variant
Dim a As Integer
Dim b As Integer
Dim c As Integer
Worksheets("Ind. Supp. Plan Time").Select
Cells(suppRow, "I").Select
For j = 9 To 13
c = j - 8
ReDim myArray(5, 4) As Variant
myArray(c, 1) = c
'ReDim Preserve myArray(5, 4) As Variant
If Cells(suppRow, j).Value = "*" Then
ReDim Preserve myArray(5, 4) As Variant
'myArray(j - 8, 1) = j - 8
myArray(j - 8, 2) = Cells(suppRow, "P").Value
myArray(j - 8, 3) = Cells(suppRow, "Q").Value
myArray(j - 8, 4) = Cells(suppRow, "R").Value
MsgBox "array = {" & myArray(c - 1, 2) & "}"
Else
ReDim Preserve myArray(5, 4) As Variant
myArray(j - 8, 2) = "1"
myArray(j - 8, 3) = "1"
myArray(j - 8, 4) = "1"
MsgBox "array(1,3) = {" & myArray(1, 3) & "}"
End If
Next j
ReDim Preserve myArray(5, 4) As Variant
'For a = 1 To 5
' For b = 1 To 4
' MsgBox "Array = {" & myArray(a, b) & "}"
' Next b
'Next a
End Sub
I put in MsgBox to view the result of executing the code, I am sure the lines are executed as expected.
If I print the value of the array straight away after assign one value to it, the value printed is correct.
However, now I can't solve this problem.
Hopefully anyone know this can give me a help.
Thank you very much!
Not sure why you can't retrieve values. I tested this and it works.
Sub singleEntry(suppRow As Integer)
Dim arrStore(1 To 5, 1 To 4) As Variant, col As Integer, r As Integer, c As Integer
Worksheets("Ind. Supp. Plan Time").Select
For col = 9 To 13
arrStore(col - 8, 1) = col - 8
arrStore(col - 8, 2) = IIf(Cells(suppRow, col) = "*", Cells(suppRow, "P"), 1)
arrStore(col - 8, 3) = IIf(Cells(suppRow, col) = "*", Cells(suppRow, "Q"), 1)
arrStore(col - 8, 4) = IIf(Cells(suppRow, col) = "*", Cells(suppRow, "R"), 1)
Next col
For r = 1 To 5
For c = 1 To 4
Debug.Print arrStore(r, c)
Next c
Next r
End Sub
Points to note:
Given that you always fill the array there is no need to ReDim. It's redundant (and expensive)
I've used the ternary IIF statement to tidy up the code i.e. if "*" then x else 1
I don't think you need the variable c so I've removed it
I've added a simple loop at the end to print out the array (which works for me)
Does this solve it?

Resources