I'm working on a parser for use at work. Basically I have an excel document full of rows of data that I need to parse through and store into a multidimensional array to work with.
Here is the code I have so far:
Dim a
Dim iRows As Long
Dim i As Integer
Dim aArray() As Variant
a = Array(2,3,4,5,6,9,10,14,19,21,23,25,29,38)
iRows = ActiveWorkbook.Sheets(1).UsedRange.Rows.Count
ReDim aArray(iRows, UBound(a))
For i = 2 To iRows + 1
For x = 0 To UBound(a)
aArray(i - 2, x) = ActiveSheet.Cells(i, a(i - 2)).Value
Next x
Next i
Keep in mind the offset of i = 2 and iRows + 1 is to ignore the header row
The problem is that when I attempt to output it I am finding that all the rows are the same so aArray(0,1) and aArray(1,1) are the same values which they should be different values from different rows of the excel file.
furthermore there should be 14 columns that I am storing per row but when i try to output any value past location 9 i get an out of range error like so
ActiveSheet.Cells(1, 1).Value = aArray(10, 0)
ActiveSheet.Cells(1, 2).Value = aArray(11, 0)
Based on the small array I am using to specify which values to store in the main array their should be 14 total locations for each sub array contain within aArray.
Any insights?
Keep in mind that this is my first real VBA script so if I am making mistakes please have patients with my I m coming from a JS/PHP background so this is a lot different for me.
You switched the dimensions in aArray. In the code you redim and fill aArray with (count_of_rows_in_usedRang,count_of_elements_in_a) and I imagine used rang is just 9 lines, so aArray(10, 0) is out of range while aArray(0,10) wouldn't be.
I think there may be a similar problem with the output in the first part of your question. If not: please post, what is in the excel-sheet and what you got as a result.
If you are looking to simply read data from a worksheet, ignoring the headings, you're over complicating it. Something like this will work:
Const intOffsetRow As Integer = 2
Dim rngUsedRange As Range
Dim varWksArray As Variant
Set rngUsedRange = ActiveWorkbook.Sheets(1).UsedRange
With rngUsedRange
varWksArray = .Range(Cells(intOffsetRow, 1), Cells(.Rows.Count, .Columns.Count)).Value
End With
Set rngUsedRange = Nothing
If you don't mind there being a blank / empty row / dimension in your array, it can be simplified even further:
Const intOffsetRow As Integer = 1
Dim rngUsedRange As Range
Dim varWksArray As Variant
Set rngUsedRange = ActiveWorkbook.Sheets(1).UsedRange
varWksArray = rngUsedRange.Offset(intOffsetRow, 0).Value
Set rngUsedRange = Nothing
Related
I am new to StackOverflow, apologies in advance if I am not going about this in the right way.
I have some raw data that looks like the following:
All the values are separated by commas, in this string I am looking to find if the full range of numbers (1,2,3,4,5) is found, if it does, then it should return a 100% match.
In case only 4 numbers out of this range are found then it should return 80%, for 3 numbers 60%, for 2 numbers 40%, for 1 number 10% and in case none are found it should return "none". (see desired output below)
I am still new to VBA, but my thought was to split my comma separated values into an array, and then try to find a match. However unfortunately I already got stuck at the first match (i.e. finding 100%).
Sub CheckNumberMatches()
Dim i As Long
Dim Elem As Variant
Dim myArr As Variant
With Worksheets("data")
For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
myArr = Split(.Range("A" & i).Value, ",")
' loop through array elements and look for 1,2,3,4,5
For Each Elem In myArr
If Elem Like "1,2,3,4,5" Then
.Range("B" & i).Value = "100%"
Exit For
End If
Next Elem
Next i
End With
End Sub
After #FunThomas his reply, I realize my requirements are not very clear, let me provide a few more examples of what can happen:
The main criteria is (1,2,3,4,5) needs to be found in the cell, but this does not need to be in numerical order, i.e. can be random (2,4,1,3,5). If all these numbers are found in any order it should be 100%.
If for example all five numbers are found (1,2,3,4,5) in the cell, but the cell also includes other numbers (1,2,3,4,5,6,7) - it should still be counted as 100%.
If for example only four numbers of the main criteria are found (for example: 1,2,4,5) it should be considered as 80% (as long as 4 out of main numbers are found), likewise for 3, 2, 1 and 0 matches.
The data can have gaps, i.e. it can be a range of (5,2,7,11,12), in this particular example it should be counted as 40% (2 out of 5 choices are found).
Duplicate numbers are not possible.
I hope that clarifies.
Array approach
Instead of looping through each cell in column "A" which can be time consuming, you can benefit from using arrays:
Assign data to 1-based 2-dim data field array (see section 3),
analyze each splitted element cur in a single loop (section 4), where counting the result of Match() with two array inputs receives the wanted information in one go via
Application.Count(Application.Match(cur, base, 0))
Note that Application.Count() neglects errors resulting from non-findings.
All infos are reassigned to the data array and written back via rng.Offset(, 1) = data
Sub FoundBaseNumbers()
With Tabelle1
'1. Assign needed base numbers to 1-dim array
Dim base As Variant: base = Split("1,2,3,4,5", ",")
'2. Define data range
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Dim rng As Range
Set rng = .Range("A1:A" & lastRow)
'3. Assign data to 1-based 2-dim data field array
Dim data As Variant: data = rng.Value2
'4. Analyze data
Dim i As Long, cur As Variant, cnt As Long
For i = 1 To UBound(data)
'a) count findings of current elements
cur = Split(data(i, 1), ",")
cnt = Application.Count(Application.Match(cur, base, 0))
'b) remember percentages using data field array
data(i, 1) = IIf(cnt, Format(cnt / (UBound(base) + 1), "0%"), "None")
Next i
'5. Write data to neighbour column
rng.Offset(, 1) = data
End With
End Sub
You started off well for your code. There are many ways something like this can be done. I've done up a simple way for you utiziling your code already. Have a look below and see if it's right for you.
I used Select Case as it allows to check for multiple things a lot easier than an If statement. You can even use ranges like Case 1 To 10. You can also do multiple Case lines to have different results do different things (like an ElseIf) etc.
Sub CheckNumberMatches()
Dim i As Long, Elem As Variant, myArr As Variant, Counter As Long
With Worksheets("data")
For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
myArr = Split(.Range("A" & i).Value, ",")
Counter = 0
' loop through array elements and look for 1,2,3,4,5
For Each Elem In myArr
Select Case Elem
Case 1, 2, 3, 4, 5
Counter = Counter + 1
End Select
Next
If Counter > 0 Then
.Cells(i, "B").Value = Format(Counter / 5, "0%")
Else
.Cells(i, "B").Value = "None"
End If
Next i
End With
End Sub
Looking for a more appropriate approach. I have a working solution, but it seems there should be a built-in or more elegant method.
I am comparing two sheets from separate workbooks, documenting the differences on a sheet in current workbook. Every time a difference is found, I'm generating a row of output data. As I'm unaware of the total number of differences I will find, the row of output data is appended to an ArrayList.
I have a working bit of code, but the effective method is:
Create a row as an arraylist.
Convert the row to an array.
Add the row to an arraylist for output
TWICE Transpose the output arraylist while converting to an array
Output the array to worksheet.
With all the benefit of using ArrayLists, it seems that there should be a direct method for outputting a 2D "ArrayList of ArrayLists" or something along those lines.
Here is the current code:
Sub findUnmatchingCells()
Dim oWB_v1 As Workbook, oWB_v2 As Workbook, oRange_v1 As Range, oRange_v2 As Range
On Error GoTo endofsub
With Me
.Cells.Clear
.Cells(1, 1) = "Row"
.Cells(1, 2) = "Column"
.Cells(1, 3) = "v1"
.Cells(1, 4) = "v2"
End With
Dim missing_items As Object
Dim output_row(), output(), missing_row As Object
Set oWB_v1 = Workbooks("foo.xls")
Set oWB_v2 = Workbooks("bar.xls")
Set oRange_v1 = oWB_v1.Sheets(1).Range("A1:AD102")
Set oRange_v2 = oWB_v2.Sheets(1).Range("A1:AD102")
Set missing_items = CreateObject("System.Collections.ArrayList")
For rRow = 1 To oRange_v1.Rows.Count
For cCol = 1 To oRange_v1.Columns.Count
If oRange_v1.Cells(rRow, cCol) <> oRange_v2.Cells(rRow, cCol) Then
Set missing_row = CreateObject("System.Collections.ArrayList")
missing_row.Add rRow
missing_row.Add cCol
missing_row.Add oRange_v1.Cells(rRow, cCol).Value2
missing_row.Add oRange_v2.Cells(rRow, cCol).Value2
output_row = missing_row.toarray
missing_items.Add output_row
End If
Next cCol
Next rRow
output = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(missing_items.toarray))
'my own output routine
If Not outputArrayToRange(output, Me.Range("A2")) Then Stop
Exit Sub
endofsub:
Debug.Print rRow, cCol, missing_items.Count, missing_row.Count, Error
Stop
End Sub
Seems like a lot of extra work here with ArrayList when you are not really using anything useful from them. As you know the mismatch count cannot be more than the number of start elements, and the columns will be 4 at end, you can do all of this just with a single array. Pre-size the array and in your loop populate it.
Simplified example:
As you are using Me this code would be in "Sheet1".
Now it would get more complicated if you wanted to ReDim to actual number of mismatches to avoid over-writing something, but generally it is wise to plan developments to avoid such risks. You would need the double transpose to be able to ReDim the rows as columns then back to rows.
With the ranges you mention I don't think the Transpose limit would be an issue, but that is a concern in other cases which needs to be resolved with additional looping.
The efficient way is to use arrays the whole time. Read the two ranges into arrays, loop one and compare against the other, write out changes to pre-sized array, write array to sheet
If this is just about is there nicer functionality for this within ArrayLists, no. What you have done is short and effective but incurs more overhead than is necessary.
Option Explicit
Public Sub findUnmatchingCells()
Dim oWB As ThisWorkbook, oRange_v1 As Range, oRange_v2 As Range
With Me
.Cells.Clear
.Cells(1, 1) = "Row"
.Cells(1, 2) = "Column"
.Cells(1, 3) = "v1"
.Cells(1, 4) = "v2"
End With
Dim rRow As Long, cCol As Long
Set oWB = ThisWorkbook
Set oRange_v1 = oWB.Worksheets("Sheet2").Range("A1:D3") 'would be faster to read this into array and later loop that
Set oRange_v2 = oWB.Worksheets("Sheet3").Range("A1:D3") 'would be faster to read this into array and later loop that
Dim totalElements As Long, output()
totalElements = oRange_v1.Rows.Count * oRange_v1.Rows.Count
ReDim output(1 To totalElements, 1 To 4)
For rRow = 1 To oRange_v1.Rows.Count 'would be faster to loop arrays than sheet
For cCol = 1 To oRange_v1.Columns.Count
If oRange_v1.Cells(rRow, cCol) <> oRange_v2.Cells(rRow, cCol) Then
output(rRow, 1) = rRow
output(rRow, 2) = cCol
output(rRow, 3) = oRange_v1.Cells(rRow, cCol).Value2
output(rRow, 4) = oRange_v2.Cells(rRow, cCol).Value2
End If
Next cCol
Next rRow
oWB.Worksheets("Sheet1").Cells(2, 1).Resize(UBound(output, 1), UBound(output, 2)) = output
End Sub
Other thoughts:
You can have early bound if adding references is not a concern:
From: https://www.snb-vba.eu/VBA_Arraylist_en.html
ThisWorkbook.VBProject.References.AddFromFile "C:\WINDOWS\Microsoft.NET\Framework\v4.0.30319\mscorlib.tlb"
or
ThisWorkbook.VBProject.References.AddFromguid "{BED7F4EA-1A96-11D2-8F08-00A0C9A6186D}", 2, 4
You are wasting an already created object by continually re-creating your missing_row ArrayList within loop. Create it once, before the loop, and just before you loop round again call the .Clear method.
I am doing some code to put a range into an array so i can create plots by analyzing the data inside that array. I am trying to use a general code for the range since the input can be different depending on the type of analysis i want to perform. Tried to find a solution for this in other questions without success.
Dim DieBankArray As Variant
last_row = Sheets("Tabela CT geral").Range("A2").End(xlDown).Row 'Last row of the data set
For i = 0 To last_row - 2 '-2 to exclude the first line and another value because the array first position is 0, not 1
DieBankArray(i) = Range("A" & i + 2)
Next
The return is a type mismatch error that i can't understand...
Here's one approach:
Function RangeTo1DArray(rngStart As Range)
Dim rv(), arr, r As Long, n As Long
'read the source data to an array for better performance
With rngStart.Parent
arr = .Range(rngStart, .Cells(Rows.Count, rngStart.Column).End(xlUp)).Value
End With
n = UBound(arr, 1)
ReDim rv(0 To n - 1)
'Fill the output array. Note: purposefully not using transpose()
' to avoid its limitations
For r = 1 To n
rv(r - 1) = arr(r, 1)
Next r
RangeTo1DArray= rv
End Function
Ok, i used the Redim and it worked just fine.
What i couldn't understand is that there's a need to set the correct size of an array to read/write data. I thought a simple Dim as Variant should be enough to store the data at my will without need to set a correct size each time i want to use an array.
The code after ReDim:
Dim DieBankArray As Variant
last_row = Sheets("Tabela CT geral").Range("A2").End(xlDown).Row 'Last row of the data set
ReDim DieBankArray(A2 To last_row - 2)
For i = 0 To last_row - 2 '-2 to exclude the first line and another value because the array first position is 0, not 1
DieBankArray(i) = Range("A" & i + 2)
Next
I am attempting to parse through a contiguous range of data (orng) and create subranges from orng that contain the same string value in the 6th column of orng. Each subrange has 1-15 rows and 38 columns. As far as I know, I can't create a new range object for each subrange since the number of subranges is unknown. I've created an array that contains the data for the subranges (aData). I have gotten it to work with the code below, but I feel like there is a much cleaner way of doing it that I can't figure out. I've also tried using a dictionary with no success. I will eventually have to call upon all the data for calculations and using multiple nested for loops to access each element seems convoluted.
I am using Excel Professional Plus 2016 (not sure if that matters).
Using an array is the only way I could manage to get the end result I'm looking for, which is fine. I would prefer that the array was dynamic, but whenever I attempted the ReDim Preserve method the values would not be saved to the array. The size of the array would be perfect, but every element was "Empty". According to Microsoft "each element of an array must have its value assigned individually" so I guess I can't assign range values to an array in chunks. After I found that webpage I implemented an array with a predetermined structure and the nested for loops.
Ideally, I could separate orng into different Areas, but since it is contiguous I am unable to do so. What I'd like to know is 1) is there a better way to do what I am trying to do? (Easier to read, faster, less code, etc. and 2) if there is not a better way, can I get some advice on how to make this code cleaner (dynamic range, less loops, better structure)?
Private Sub rangetest()
Dim twb As Workbook: Set twb = ThisWorkbook
Dim cws As Worksheet: Set cws = twb.Sheets("Cleaned_2019+")
Dim orng As Range
Dim datelot As String, datelotcomp As String
Dim c As Long, i As Long, j As Long, k As Long, numrows As Long, lastrow
As Long, numlots As Long, _
curRow As Long, lotRows As Long, startRow As Long, layerRows As Long,
aRow As Long
Dim aLot() As Variant, aData(9, 49, 37) As Variant
Dim Z As Boolean
Set orng = cws.Range("A973:AL1014") 'Set initial range to work with.
numrows = orng.Rows.Count 'Number of rows in orng.
curRow = 1 'Current row in orng.
startRow = 1 'Starting row in orng for next
layer (changes when lot changes).
i = 0 'Layer of array (for aLot and aData arrays).
j = 0 'Row in orng where values for previous layer ended.
Z = False
Do Until Z = True
datelot = Left(orng.Cells(curRow, 6).Value, 10) 'Lot that we want the data for. Corresponds to a layer in the aData array.
datelotcomp = Left(orng.Cells(curRow + 1, 6).Value, 10) 'Lot of the next row in data sheet.
If datelot <> datelotcomp Then 'If datelotcomp <> to datelot then we want a new layer for array.
layerRows = curRow - j 'Number of rows for a particular layer
ReDim Preserve aLot(i) 'Array of lot names
aLot(i) = datelot 'Assign lot name to aLot array
For aRow = 1 To layerRows 'Row index in array
For lotRows = startRow To curRow 'Loops through orng rows and sets those values in array
For c = 1 To 38 'Loops through columns. There are always 38 columns
aData(i, aRow - 1, c - 1) = orng.Cells(lotRows, c).Value 'Add values to each index in array
Next c
Next lotRows
Next aRow
j = curRow
i = i + 1
startRow = curRow + 1
End If
If curRow = numrows Then 'End loop at end of orng
Z = True
End If
curRow = curRow + 1
Loop
numlots = i
End Sub
The result I get is an array with the structure aData(9, 49, 37) that contains data in the first 4 layers aData(1-3, , ). This corresponds with the number of lots that are in orng so the code is working correctly. I'd just like advice on if I'm doing anything inefficiently.
I will be checking back to answer questions or to add clarification.
Edit 1:
The question ended up being answered here (Code Review) for those interested.
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.