How to assign an Excel Range to a 2D array? - excel

Could you please say- how a Excel Range("G2:AA1000") can be assigned to a 2D array? If possible how to return back that 2D array to the same range after performing some operation on that 2D array?After assignment a Range to an 2D array,How each row will be identified from that 2D matrix?
Thanks,

There is an easy way to make changes to an area using an array, and write it out to the same place, or somewhere else.
This example code will copy data from one area to another, using an array:
Sub example()
Dim testdata()
testdata = Range("A1:B13")
Range("D1:E13") = testdata ' simple copy
Range("G1") = testdata ' copy only 1 cell
Range("I1:K22") = testdata 'try to copy too much
End Sub
The testdata array starts from 1, and will extend to the number of columns and rows specified in the range. In this case, testdata(1,1) refers to the data obtained from A1, testdata(1,2) refers to B1, finishing up with testdata(13,1) referring to A13, and testdata(13,2) referring to B13.
Setting the range equal to the array in the next line copies the array into the specified location.
If the area is smaller than the original array, it will copy only enough of the array to fill that space, so Range("D1")=testdata will only place one cell on the sheet.
If you specify a larger area, then #N/A will fill the area that is not in the space covered by array elements, so Range("A1:A3")=testdata will fill A1 and A2 with data from the array, but A3 will have #N/A
Result of example program:
Note: A1:B13 is the original data, which gets copied with the subsequent range(??)=testdata

Here's a worked-out example of reading a range of data from a worksheet, operating on the array, and then writing it back out to the same worksheet.
Sub RangeArray()
Dim Rng As Range
Dim Arr()
Dim ArrItem
Dim i As Long, j As Long
Dim rUB as Long, cUB as Long
Set Rng = Worksheets("Sheet1").Range("A1:G19")
rUB = Rng.Rows.Count 'Row upper bound
cUB = Rng.Columns.Count ' Column upper bound
ReDim Arr(1 To rUB, 1 To cUB)
'Read worksheet range into array
For i = 1 To rUB
For j = 1 to cUB
Arr(i, j) = Rng.Cells(i, j).Value
Next
Next
'Do something to array
For i = 1 To rUB
For j = 1 To cUB
If i <> j Then
Arr(i, j) = Arr(i, j) / (i * j)
End If
Next
Next
'Write array back to worksheet
Set Rng = Worksheets("Sheet1").Range("I1")
For i = 1 To rUB
For j = 1 To cUB
Rng.Offset(i - 1, j - 1).Value = Arr(i, j)
Next
Next
End Sub

Yes, an Excel range can be assigned to a 2D array in one single assignment. In C++/CLI it looks like this:
cli::array<Object^, 2>^ arrData = safe_cast<cli::array<Object^, 2>^>(rg->Value[Excel::XlRangeValueDataType::xlRangeValueDefault]);
In c# or visual basic it would look considerably simpler (see here for example https://www.automateexcel.com/vba/assign-range-to-array/, btw in dotnet the object is now playing the role of the variant data type). Note that it must be a two dimensional array and the returned array has a one-based indexing, and not a zero based indexing.
For large data sets this method is a lot faster than the looping. The looping generates lots of COM objects. I compared the two methods with a 33000 row Excel range and the data import into the array was almost instantaneous while with the looping it took very long and it heated up the CPU.

One way to loop through a range is to use the For...Next loop with the Cells property. Using the Cells property, you can substitute the loop counter (or other variables or expressions) for the cell index numbers. In the following example, the variable counter is substituted for the row index. The procedure loops through the range C1:C20, setting to 0 (zero) any number whose absolute value is less than 0.01.
Sub RoundToZero1()
For Counter = 1 To 20
Set curCell = Worksheets("Sheet1").Cells(Counter, 3)
If Abs(curCell.Value) < 0.01 Then curCell.Value = 0
Next Counter
End Sub

Related

How to count number of occurrences of a value and the value of adjacent cell in a range

Edit: This question has been re-worked to provide better clarity of my problem.
There's 2 factors to my question.
First Factor: I have a validation list in a sheet called "Admin Sheet". In that list are 'Tasks'.
I would like to cross reference those tasks in the "list", against those contained in a range (rangeString) taken from another sheet and count the number of 'Occurrences' for each item.
i.e. Task 1 appears 3 times, Task 2 appears 1 time, etc etc..
Factor 2: For each item within the list I would also like to gather the number of 'Hours' spent on that task.
For example:
Task 1 may appear 3 times on 3 different rows within the range. On each row in another column are the hours spent on that particular task. I would like to 'Sum' those hours from the 3 rows and I'd like to do this for all the 'Tasks'.
Note: The range is variable and will change daily.
Note: The columns that contain the info are: 'F' - Tasks and 'K' for Hours.
My current attempt at just capturing 'one' Task and its Hours associated with it:
Dim PaintWWArray() As Variant
Dim PHoursCnt As Long
Set srchRng = ActiveSheet.Range(rangeString)
Set rngfindValue = srchRng.find(what:="AD PAINTING W/W", Lookat:=xlPart)
'Find all the Tasks and Hours
If Not rngfindValue Is Nothing Then
rngFirstAddress = rngfindValue.Address
Do
PaintWWCnt = PaintWWCnt + 1
PHoursCnt = rngfindValue.Offset(0, 4).Value
ReDim Preserve PaintWWArray(PHoursCnt)
PaintWWArray(PHoursCnt) = PHoursCnt
Set rngfindValue = srchRng.FindNext(rngfindValue)
Loop Until rngfindValue Is Nothing Or rngfindValue.Address = rngFirstAddress
PWWSum = Application.WorksheetFunction.Sum(PaintWWArray)
MsgBox PWWSum
End If
Once I have collected the number of 'Occurrences' for each Task and the Sum of the hours for each task, I want to pass them into another sheet.
Worksheets("Weekly Data").Range("C6").Value = PaintWWCnt
Worksheets("Weekly Data").Range("D6").Value = PWWSum
I hope this is clearer...
I would suggest using a Dictionary.
Assuming you want to count all words:
Dim myDict
Set myDict = CreateObject("Scripting.Dictionary")
' Go through the array
For Each addDuty In arr
' If you only want to count specific words, add in IF statement here
myDict(addDuty) = myDict(addDuty) + 1
Next addDuty
If you only want to count words in an exiting set, it becomes slightly more elaborate.
It's not entirely clear what you want to achieve but the code below should give you the data you need. It's very fast. Please try it.
Private Sub STO_Answer()
' 024
' this procedure requires a reference to be set to
' Microsoft Scripting Runtime
Dim Counter As Scripting.Dictionary ' store task names and their count
Dim Arr As Variant ' an array of the data in Rng
Dim CellVal As Variant ' temporary storage of each cell value
Dim R As Long ' row counter
Dim Key As Variant ' a dictionary Key
Arr = ActiveSheet.Range("C2:D27").Value ' change to name the sheet
' adjust the range to suit
Set Counter = New Scripting.Dictionary
With Counter
For R = 1 To UBound(Arr) ' loop through all rows
AddToCounter Arr(R, 1), Counter ' first column of cell range
AddToCounter Arr(R, 2), Counter ' second column of cell range
Next R
For Each Key In Counter.Keys
Debug.Print Key, Counter.Item(Key)
Next Key
End With
End Sub
Private Sub AddToCounter(CellVal As Variant, _
Counter As Scripting.Dictionary)
' 024
With Counter
If .Exists(CellVal) Then
.Item(CellVal) = .Item(CellVal) + 1
Else
.Add CellVal, 1
End If
End With
End Sub
A Dictionary is a data structure which holds two related values. Here it's used to hold the task name and the number of times it occurs. Make sure you enable the reference to Microsoft Scripting Runtime in Tools > References. You don't specify if there is any relationship- between the tasks in the first column and the second. The above code counts both independently for now.
The result is printed to the Immediate Window. Of course, you might use this result in any other way in your code. Your question doesn't cover your intentions.
You won't be able to escape from the necessity to present your count in some way forever. As it turns out, there is only one efficient way to do it. This one:-
All duties are in column A and all added duties are in row 2.
Of course, you might use rather elaborate VBA to do the counting but Excel has a better way using a worksheet function. In order to set up COUNTIF() to work I created two named ranges as follows.
["Duties"] =OFFSET(Sheet2!$C$2,0,0,COUNTA(Sheet2!$C:$C)-1)
and
["AddDuties"] =OFFSET(Duties,0,1)
Sheet2!$C$2 is where my data started. Replace with the first cell of the first column of your data range. COUNTA(Sheet2!$C:$C)-1 makes this range dynamic. The function counts how many entries there are in that same column, -1 because the count would include a caption (modify if you have more or fewer headers).
AddDuties is simply defined as "same as Duties" but removed by one column to the right. You could move it elsewhere. As you add or delete rows in the column of Duties, AddDuties expands or contracts right along.
Now the formula in B3 is shown below. It's copied down and across as required. Please observe the $ signs.
[B3] =COUNTIFS(Duties,$A3,AddDuties,B$2)
This will probably generate a lot of zeroes. It did in my example and I didn't like them. Therefore I formatted B3 with the Custom cell format 0;; before copying to the other cells, which hides them.
Now this list would automatically update as you make entries in your data. You will never have to run code and the list will always be ready.
Finally, one recommendation. All your added duties, like "AD PAINITNG H/R", are hard to type correctly. Therefore the user should select them from a validation drop-down when entering them in the data. Most probably, you already have a list somewhere which feeds such drop-downs. The captions in the count list must be taken from the same source. But that creates redundancy. The better way is to make the list in B2:H2 of the count list the "original". Name the range and make it dynamic and you will never have to think about this subject again.
i think a better approach would be to use for each loops, this way you won't have to hardcode the conditions via IfElse. If you have the values in column A of a sheet and wants to go through those values and get their adjacent value in column B, you can use For Each looping to go through each values defined in A to get B.
just to add, regarding on counting of occurrence, you can define a counter that would add up for each occurrence of a unique value in column A.
I do not have time to wait for clarifications I asked... I prepared a piece of code, starting from the assumption that your strings to be counted are in column "F:F", and the value to be calculated is in column "K:K". The processing result is dropped on the last available column of the active pages, starting from row 2. If you prefer some relevant headers for the two involved columns, this can be easily automated. I used "Tasks and "Time...
It is able to deal with as many 'task' strings you will have in the future.
I commented the code lines, where I thought you do not understand what they do:
Sub CountOccurrencesAndValues()
Dim sh As Worksheet, rngF As Range, arrOcc As Variant, lastRow As Long, lastCol As Long
Dim arr As Variant, arrFin As Variant, countI As Long, valH As Double, j As Long, k As Long, i As Long
Set sh = ActiveSheet
lastRow = sh.Range("F" & Rows.count).End(xlUp).Row
lastCol = sh.UsedRange.Columns.count + 1
Set rngF = sh.Range("F2:F" & lastRow) 'the range where from to extract the unique values
arr = sh.Range("F2:K" & lastRow) 'the array to be processed
'Extract the unique values. Use for that a not used column:
rngF.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=sh.Cells(1, lastCol), Unique:=True
'Put the unique values (sttrings) in an array:
arrOcc = sh.Range(sh.Cells(1, lastCol), sh.Cells(sh.Cells(Rows.count, lastCol).End(xlUp).Row, lastCol)).value
'Clear the temporary used array:
sh.Range(sh.Cells(1, lastCol), sh.Cells(sh.Cells(Rows.count, lastCol).End(xlUp).Row, lastCol)).Clear
ReDim arrFin(1 To UBound(arrOcc, 1), 1 To 3)
k = 1
'Processing the range by iteration:
For i = 1 To UBound(arrOcc, 1)
For j = 1 To UBound(arr, 1)
If arr(j, 1) = arrOcc(i, 1) Then
'count the occurrences and the value
countI = countI + 1: valH = valH + arr(j, 6)
End If
Next j
'put the data in the final array
arrFin(k, 1) = arrOcc(i, 1): arrFin(k, 2) = countI: arrFin(k, 3) = valH
countI = 0: valH = 0: k = k + 1
Next i
'Drop the data from array in the last available column:
'sh.Cells(1, lastCol).value = "Tasks": sh.Cells(1, lastCol + 1).value = "Count": sh.Cells(1, lastCol + 2).value = "Time"
'sh.Cells(2, lastCol).Resize(UBound(arrFin, 1), UBound(arrFin, 2)).value = arrFin
Dim ws As Worksheet
Set ws = Worksheets("Weekly Data")
'Drop the data from array in "Weekly Data" worksheet:
ws.Range("C6").value = "Tasks": ws.Range("D6").value = "Count": ws.Range("E6").value = "Time"
ws.Range("C7").Resize(UBound(arrFin, 1), UBound(arrFin, 2)).value = arrFin
End Sub

Inserting data in multidimensional array

I have to move data in my input files to another workbook. The data is structured in worksheets as hardcoded input as below where the column with all the identifiers is a named range called "INPUT_MARKER".
IQ_SALES 100 200 300
IS_MARGIN 20 30 40
IQ_EBITDA 50 30 20
I only have to move some of the data. So for instance in the above I would only have to move the IQ_SALES data and IQ_EBITDA data. So I need to understand how to create an array of arrays with only the data that is needed.
The code below compares the data in the INPUT_MARKER column with elements in the array called "identifierArray" and I then intend to insert all of the row data in the multidimensional array called "bigDataArray". I have tried several approaches but have not been able to make this work. Would much appreciate any help. I have left out some of the redundant code in the below such that only the code pertaining to this problem is included.
Sub Update()
Dim identifierArray(), bigDataArray() As Variant
Application.ScreenUpdating = False
Application.CutCopyMode = False
'Definition of the array of data that is to be transferred to the targetModel
identifierArray = Array("IQ_SALES", "IQ_EBITDA")
ReDim bigDataArray(1 To UBound(identifiersArray))
With Workbooks(sourceModel).Sheets("DATA")
For Each c In .Range("INPUT_MARKER")
For Each element In identifierArray
If element = c.Value Then
'To construct bigDataArray by inserting row data every time element equals c.Value
End If
Next element
Next c
End With
End Sub
I've tackled a similar issue recently. This can be handled with a multi-dimensional array from the look of things
Though as a predisposition I'd recommend checking reference on dynamic
multi-dimensional
arrays
Private Sub fill_array()
Dim arr() As String
Dim i As Integer: i = 0
Dim cell As Range
Dim ws As Worksheet: Set ws = Sheets("DATA")
For Each cell In ws.Range("INPUT_MARKER")
If ws.Cells(cell.Row, 1) = "IQ_SALES" Or ws.Cells(cell.Row, 1) = "IQ_EBITDA" Then
ReDim Preserve arr(0 To 2, i)
arr(0, i) = ws.Cells(cell.Row, 2)
arr(1, i) = ws.Cells(cell.Row, 3)
arr(2, i) = ws.Cells(cell.Row, 4)
i = i + 1
End If
Next cell
End Sub
So your array will have the structure ofarr(x, y), where:
x - [0;2] - will be the 3 columns of data you want to store
y - n - index of the array (with only IQ_SALES and IQ_EBITDA being added)
EDIT:
This is of course presuming, your data "INPUT_MARKER" starts at
Column A
Also as an extra tip, if you want to also store information of the arrays source - in resemblence of a primary key, you can increment the first dimension
ReDim Preserve arr(0 to 3, i)
arr(3, i) = cell.Row ' edited (instead of arr(3)= …)
and use example the cell.Row as a reference as to where the data was obtained from, in order to reverse trace the data
If you know the range of the values you want to pick you can shortcut using:
Dim bigDataArray() As Variant
bigDataArray = Range(A1:D4)
This will set up the array with the same size as the range you pick up,
Then you can output the specific values you want from the array.

Convert a 2D array to a 1D array

How do I work around the 255 characters per cell limit when converting a range (= multidimensional array) to single dimensional array with the use of Application.Index(array, row, column)?
The following truncated example reproduces the error:
Error 13. Type mismatch
(The complete code is on superuser where I tried to help another user).
How to reproduce
Open a new Excel sheet and insert the formula =REPT("x",256) to cell A1
This creates a 256 characters long string which is just 1 character too long for the last step
Open the VBA editor (Alt+F11) and paste the below code somewhere
Execute the code line by line with F8
Function StringLengthTest()
Dim arr2D As Variant
Dim arr1D As Variant
arr2D = Rows(1)
arr1D = Application.Index(arr2D, 1, 0)
End Function
You'll see the same error at the last line when Excel tries to convert a range (2D) to a 1D array while one of its cells has more than 255 characters.
To prove this, change =REPT("x",256) to =REPT("x",255) and run the code again. This time it will work.
Question: Should I declare my variables in another way? Is there a better way to convert a range (which is always a 2D object at first) to a single dimensional array?
I know I could use a loop to iterate through the arrays and save all 2D array values one by one to a 1D array. But that's not efficient. Imagine really large sheets.
by far the best way of getting anything from a cells into memory (an array) is to use an array variant. I think the problem you are having is with index not with your method.
Hopefully this code should explain it.
Dim v_data As Variant
Dim rw As Long, cl As Long ' for row and column
Dim arr1d() As Variant
Dim count As Long
' I'm going to use UsedRange to get the whole sheet .UsedSheet
' If you just want things from one row or column then just spec
' activesheet.range("A1:A100") or use cells()
With ActiveSheet.UsedRange
ReDim v_data(1 To .Rows.count, 1 To .Columns.count)
v_data = .Value
End With
'now we have all the things from that sheet.
'so to convert to 1d array where the cell value is say = 1
For rw = LBound(v_data) To UBound(v_data)
For cl = LBound(v_data, 2) To UBound(v_data, 2) ' note the comma 2 for the second dimension bounds.
If v_data(rw, cl) = 1 Then
count = count + 1
ReDim Preserve arr1d(1 To count)
arr1d(count) = v_data(rw, cl)
End If
Next cl
Next rw
For count = LBound(arr1d) To UBound(arr1d)
Debug.Print arr1d(count)
Next count
now the trick is to farm this off to a function that takes a few args( a 2d range, what you are looking for in that range) and returns your list.
To get your data back into a workbook
ActiveSheet.Cells(1, 1).Resize(UBound(arr1d), 1).Value = arr1d
make a range of the exact same size in terms of the bounds of your array and then ensuring you use .value just pop in the variant array.

Summing Dynamically Varying Columns using VBA

I need to calculate the sum of values in each column and store it in an array. Please note that the number of columns are not fixed. It varies dynamically. This is where I am totally stuck. This is just a part of a huge function I am writing.
In the below code, the "Column H" that I am summing is a variable one. I mean the number of columns to calculate sum is based on the value of Val(i).
For Eg: If Val(0) = 10, then I need to calculate sum of all numbers starting from column H till column Q, and storing sum of each column in an array, i.e.sum(0) = sum of column H; sum(1) = sum of column I; and so on.
The point where I am stuck is to increment the column, i.e. after summing "Column H" in the next iteration it should sum elements in "column I"----> (Sum(i + k) = Application.WorksheetFunction.Sum(Range("H2"))
I have tried something like below:
Dim i, j, k, l, MaxVal As Integer
Dim objNewSheet As Worksheet
Dim Sum(0 To 1000) As Double
k = 0
For i = 0 To (MaxVal-1)
Set objNewSheet = ActiveWorkbook.Sheets("Sheet" & (i+1))
objNewSheet.Select
For j = 0 To Val(i)
Sum(i + k) = Application.WorksheetFunction.Sum(Range("H2"))
k = k + j
Next j
Next i
As Tim mentions, you can use the Resize method to modify the size of your Range.
Dim rng as Range: Set rng = Range("H2")
Sum(i + k) = Application.WorksheetFunction.Sum(rng.Resize(1, j))
The above should create a new range that is j columns wide.
I add a Range variable because they are easier to work with (IMO) that the constants like Range("H2"). You can use MsgBox rng.Resize(1,j).Address to view the new range's address.
Here are a few other points you may want to consider:
You have not declared your variables correctly, unless you truly
intend for i, j, k, l as Variant. You could do:
Dim i#, j#, k#, l#, MaxValue# (shorthand notation) or
Dim i as Integer, j as Integer, k as Integer, l as Integer, MaxValue as Integer
Otherwise, unless you specify a type for each variable, they will be Variant.
For readability, you may want to avoid naming variables after reserved or semi-reserved keywords or existing functions like Sum. I would rename that variable to mySum or sumArray or something else which will obviously indicate to future users that this is a variable, not a function.
I mention in my comment above that initially dimensioning your array variable with an upper-bound of 1000 is kind of clunky, and will obviously fail if you ever encounter a need for a larger array. This may not be the case, but it's still a clunky way of dimensioning an array. I would suggest Dim mySum() as Double and then ReDim the variable later in the code, perhaps using ReDim Preserve if it needs to be truly dynamic at run-time.
UPDATE
Here is a simple example, your code is only a snippet/incomplete, so I cannot use it, but this example should illustrate how this works.
Option Base 1
Sub Test()
Dim i As Integer
Dim rng As Range
Dim mySum() As Double
'## The initial range ##'
Set rng = Range("H2")
'## Do an iterative loop ##'
For i = 1 To 4
'## Resize the range within the iteration ##'
Set rng = rng.Resize(1, i) '<-- change the 1 in this line to the number of rows in the column that needs to be summed'
'## Ensure the array is properly dimensioned ##'
ReDim Preserve mySum(i)
'## Store the calculation in the array ##'
mySum(i) = Application.WorksheetFunction.Sum(rng)
Next
End Sub

empty cells returned by an array

I have been working on this particular problem for sometime and am obviously missing something very simple. I ma trying to create an aray based on a dynamic range in Excel and using the individual elements to compare against another array. The only problem with the attached code is it continues to show empty elements. Any guidance would be appreciated.
Part of my overall code attached.
Sub Test_Again()
Dim R As Long
Dim C As Long
Dim List() As Variant
Dim i As Integer
List = Sheets("Sheet11").Range("A2:A17").Value
For R = 1 To UBound(List, 1) ' First array dimension is rows.
For C = 1 To UBound(List, 2) ' Second array dimension is columns.
Debug.Print List(R, C)
Next C
Next R
ReDim List(UBound(List, 1))
Do Until i = UBound(List)
If List(i) = Now() Then
End If
i = i + 1
Loop
End Sub
The normal Redim will clear your array - unless you use Redim Preserve. However, according to the help:
If you use the Preserve keyword, you can resize only the last array dimension and you can't change the number of dimensions at all. For example, if your array has only one dimension, you can resize that dimension because it is the last and only dimension. However, if your array has two or more dimensions, you can change the size of only the last dimension and still preserve the contents of the array.
Therefore, in your case Redim will not help you here. If you want to transfer a two dimensional array to a one dimensional array, you need to do this manually instead:
Sub Test_New()
Dim lRow As Long, lCol As Long
Dim vListSource() As Variant, vListTarget() As Variant
'Assign soure array
vListSource = Sheets("Sheet11").Range("A2:A17").Value
'Show full content for debug
For lRow = LBound(vListSource) To UBound(vListSource) ' First array dimension is rows.
For lCol = LBound(vListSource, 2) To LBound(vListSource, 2) ' Second array dimension is columns.
Debug.Print vListSource(lRow, lCol)
Next lCol
Next lRow
'Transfer array to one dimension
ReDim vListTarget(LBound(vListSource) To UBound(vListSource))
For lRow = LBound(vListSource) To UBound(vListSource)
vListTarget(lRow) = vListSource(lRow, LBound(vListSource, 2))
Next lRow
'Your check code
For lRow = LBound(vListTarget) To UBound(vListTarget)
If vListTarget(lRow) = Now() Then
'Do something here
End If
Next lRow
End Sub
This will copy the first row of your range/array to a one dimensional array and use this for further processing.
However, from your code and question I do not see the advantage of redimming it to one dimension - you could easily do your loop one the two dimensional array - and just look in the first and only column.

Resources