Attempting to utilize two arrays to iterate through a data transfer process by copy and pasting cells from one sheet into a newly created one. The code below is merely responsible for copy and pasting the correct data in the correct order from one sheet to the newly created one. I'm receiving a type mismatch when attempting to initialize the arrays. It occurs on the first array, but I haven't gotten to the second array to test that yet, so it could be wrong as well.
Things to Note: 1) firmLocationColumn is of type long. 2) All the data stored in said arrays are meant to represent column numbers. They are out of order so I needed to store them in the array in the proper order so that it's easier to iterate through them rather than writing the same information over and over again.
Let me know if I missed anything that needs to be explained and i'll edit my question:
Private Sub GetSpecificTradeDetails(ByVal masterListRow As Long, ByVal firmLocationColumn As Long, ByVal newExcelConfirmSheet As Worksheet, ByVal newExcelConfirmSheetLastRow As Long)
Dim tradesMasterListColumnIndexArray() As Long
Dim newExcelConfirmColumnIndexArray() As Long
Dim arrayIndexCounter As Long
'Sets array of columns for loop iteration through data sheet
tradesMasterListColumnIndexArray() = [1,4,firmLocationColumn,(firmLocationColumn - 1),(firmLocationColumn + 3),15,16,10,11,8,19,18,17,(firmLocationColumn + 4),9,6,2]
newExcelConfirmColumnIndexArray() = [1,2,3,4,5,7,8,9,10,11,12,13,14,15,16,17,18]
Select Case firmLocationColumn
Case 25
'Sets confirm direction to "BUY"
newExcelConfirmSheet.Cells((newExcelConfirmSheetLastRow + 1), 6) = "BUY"
Case 27
'Sets confirm direction to "SELL"
newExcelConfirmSheet.Cells((newExcelConfirmSheetLastRow + 1), 6) = "SELL"
End Select
'Transfers trade details between the masterlist and the newly created confirm sheet
With TradesMasterSheet
For arrayIndexCounter = 0 To 17
.Cells(masterListRow, tradesMasterListColumnIndexArray(arrayIndexCounter)).Copy _
Destination:=newExcelConfirmSheet.Cells((newExcelConfirmSheetLastRow + 1), newExcelConfirmColumnIndexArray(arrayIndexCounter))
Next
End With
End Sub
VBA doesn't support initialization of arrays by array literals. It does, however, have an Array() function:
Dim tradesMasterListColumnIndexArray As Variant
Dim newExcelConfirmColumnIndexArray As variant
tradesMasterListColumnIndexArray = Array(1,4,firmLocationColumn,(firmLocationColumn - 1),(firmLocationColumn + 3),15,16,10,11,8,19,18,17,(firmLocationColumn + 4),9,6,2)
newExcelConfirmColumnIndexArray = Array(1,2,3,4,5,7,8,9,10,11,12,13,14,15,16,17,18)
Related
Need some help on sorting the values into the correct column.
I can't seem to figure out how I would return the array values to the proper column in the table.
For the output into column B "Pipe DN" it should return the first split text from the values in "Line number", and for the "Service" column F it should return the 2nd split text from "Line number".
How would I accomplish this? -
If for "Pipe DN" I use Range("B19", Range("B19").Offset(Dimension1 - 1, 1)).Value = StrArray, it will return me the correct values, but the "Service" code is not written on the correct column.
Sub SplitLinesIntoArray()
Dim LineNumber() As Variant
Dim StrArray() As Variant
Dim Dimension1 As Long, Counter As Long
LineNumber = Range("J19", Range("J19").End(xlDown))
Dimension1 = UBound(LineNumber, 1)
ReDim StrArray(1 To Dimension1, 1 To 2)
For Counter = 1 To Dimension1
'Pipe DN
StrArray(Counter, 1) = Split(LineNumber(Counter, 1), "-")(0)
Range("B19", Range("B19").Offset(Dimension1 - 1, 0)).Value = StrArray
'Service Code
StrArray(Counter, 2) = Split(LineNumber(Counter, 1), "-")(1)
Range("F19", Range("F19").Offset(Dimension1 - 1, 0)).Value = StrArray(Counter, 2)
Next Counter
'Range("B19", Range("B19").Offset(Dimension1 - 1, 1)).Value = StrArray
Erase LineNumber
Erase StrArray
End Sub
Basically you start well by analyzing a 2-dim datafield array and assigning resulting string manipulations (Split()) to it.
Results seem to (1) output correctly as for the first array "column" ("Pipe DN", starting in cell B19),
whereas (2) the second column ("Service", F19) repeats the result of the very last split action for each array "row".
This impression has to be qualified:
ad 1) You are doing unnecessary extra work by assigning the entire StrArray to the entire "Pipe DN" column,
repeating this action with each single row iteration. (Note that the StrArray gets only completely filled with the last loop).
ad 2) Basically you assign again with each iteration, but this time you get only the latest split result and fill the entire "Service" column
with the latest result assigned to StrArray(Counter,2). Eventually all items show the last split result instead of the individual LineNumber splittings.
See this abbreviated example for three example items only to understand what is happening
(this SnapShot shows the table results when code is stopped after the 2nd iteration (i.e. after Counter=2):
Immediate help
Sticking to your initial code, I'd omit
Range("B19", Range("B19").Offset(Dimension1 - 1, 0)).Value = StrArray as well as
Range("F19", Range("F19").Offset(Dimension1 - 1, 0)).Value = StrArray(Counter, 2)
within the For..Next loop, but add the following two code lines thereafter:
Range("B19", Range("B19").Offset(Dimension1 - 1, 0)).Value = Application.Index(StrArray, 0, 1)
Range("F19", Range("F19").Offset(Dimension1 - 1, 0)).Value = Application.Index(StrArray, 0, 2)
in order to slice the StrArray into columns and write each column separately to your cell target.
Further note:
Fully qualify your range references to prevent possibly unwanted results as Excel would take the currently active sheet if not referenced explicitly ... and this need not be the targeted one :-;
Using VBA, it's not necessary in standard office situations to clear (Erase) at the end of a procedure to free memory.
Possible alternative avoiding array slicing
You might profit from the the following code, which
fully qualifies your range references (note: unqualified refs invite Excel to take the currently active sheet without request),
uses a jagged array (aka as Array of Arrays) to avoid (multiple) column slicing (as needed in OP)
demonstrates the use of Private Constants on module top (used here for enumerating the sub-arrays within the jagged array
demonstrates a help procedure to provide for a correcty dimensioned jagged array:
Example code
Option Explicit ' declaration head of code module (forching variable declarations)
Private Const LineNum As Long = 0 ' enumerate sub-arrays within jagged array
Private Const Pipe As Long = 1
Private Const Service As Long = 2
Sub SplitLinesIntoJaggedArray()
'I. Set Worksheet object to memory ' fully qualify any range references!
Dim ws As Worksheet ' declare ws as of worksheet object type
Set ws = Tabelle1 ' << use the project's sheet Code(Name)
'set ws = ThisWorkbook.Worksheets("Sheet1") ' or: via a sheet's tabular name (needn't be the same)
With ws ' With .. End With structure, note the following "."-prefixes
'II.Definitions
'a) assign target start cell addresses to array tgt
Dim tgt As Variant
tgt = Split("J19,B19,F19", ",") ' split requires "Dim tgt" without brackets to avoid Error 13
'b) define source range object and set to memory
' Note: tgt(LinNum) equalling tgt(0) equalling "J19"
Dim src As Range
Set src = .Range(tgt(LineNum), .Range(tgt(0)).End(xlDown)) ' showing both enumerations only for demo:-)
Dim CountOfRows As Long: CountOfRows = src.Rows.Count ' count rows in source range
'c) provide for a correctly dimensioned jagged array to hold all 2-dim data arrays (three columns)
Dim JaggedArray() As Variant
BuildJagged JaggedArray, CountOfRows ' << call help procedure BuildJaggedArray
'III.Assign column data to JaggedArray
'a) assign LineNum column as 2-dim datafield to JaggedArray(LineNum)
JaggedArray(LineNum) = src.Value
'b) assign LineNum splits to JaggedArray(Pipe) and JaggedArray(Service)
Dim Counter As Long
For Counter = 1 To CountOfRows
'1. Pipe DN
JaggedArray(Pipe)(Counter, 1) = Split(JaggedArray(LineNum)(Counter, 1), "-")(0)
'2. Service Code
JaggedArray(Service)(Counter, 1) = Split(JaggedArray(LineNum)(Counter, 1), "-")(1)
Next Counter
'IV.Write result columns of jagged array to target addresses
' Note: tgt(Pipe)=tgt(1)="B19", tgt(Service)=tgt(2)="F19"
Dim elem As Long
For elem = Pipe To Service
.Range(tgt(elem)).Resize(CountOfRows, 1) = JaggedArray(elem)
Next
End With
End Sub
*Help procedure BuildJagged
Note that the first procedure argument passes the jagged array By Reference (=default, if not explicitly passed ByVal).
This means that any further actions within the help procedure have an immediate effect on the original array.
Sub BuildJagged(ByRef JaggedArray, ByVal CountOfRows As Long)
'Purpose: provide for correct dimensions of the jagged array passed By Reference
ReDim JaggedArray(LineNum To Service) ' include LineNum as data base (gets dimmed later)
Dim tmp() As Variant
ReDim tmp(1 To CountOfRows, 1 To 1)
Dim i As Long
For i = Pipe To Service ' suffices here to start from 1=Pipe to 2=Service
JaggedArray(i) = tmp
Next i
End Sub
Further link
Error in finding last used cell in Excel VBA
I am following a tutorial on VBA static arrays. I want to make sure my thought process is correct for something simple that I wish to do.
I have code that picks up all 12 months and places it into a static array of type string. As practice, I wanted to see if it's possible to copy these values onto another location using another module that acts as "pasting" the months at the cursor selection, but not utilizing a public array. I'm new to VBA so perhaps my way of think about coding is flawed and for such a purpose, I should be using a publicly defined array.
Sub PopulateStaticArray()
Dim months(11) As String
Dim ndx As Integer
Dim xrow As Long
ndx = 0
xrow = 2
Do Until Cells(xrow, 1).Value = ""
months(ndx) = Cells(xrow, 1).Value
ndx = ndx + 1
xrow = xrow + 1
Loop
End Sub
What I want to achieve in a redundant fashion. (I'm essentially recreating the array from scratch).
Sub InsertMonthsArray()
Dim counter As Integer
Dim rowNum As Double
Dim colNum As Double
Dim months(11) As String
ActiveCell.Select
rowNum = ActiveCell.Row
colNum = ActiveCell.Column
months(0) = "January"
months(1) = "February"
months(2) = "March"
months(3) = "April"
months(4) = "May"
months(5) = "June"
months(6) = "July"
months(7) = "August"
months(8) = "September"
months(9) = "October"
months(10) = "November"
months(11) = "December"
For counter = 0 To UBound(months, 1)
Cells(rowNum, colNum).Value = months(counter)
rowNum = rowNum + 1
Next counter
End Sub
I read some posts about passing arrays, but I'm not sure if that's achieving what I'm looking for. Of course this is not actual project, but just to improve my understanding of the interaction between modules within VBA for Excel. I don't necessary need any code, but just the general conceptual guidance on if I should be using some other method to achieve this task (i.e. Public defined Array or Functions, etc.) Thank you.
#GSerg mentioned correctly
"You are not creating a static array inside PopulateStaticArray. If you want to pass an already existing array to InsertMonthsArray(), regardless of where it comes from, then yes, that should be Sub InsertMonthsArray(months() as string)"
You need to pass your array - declared at procedure level - as (implicit) ByRef argument, which means that you can assign month names to each array item within the called sub procedure createMonths so that the calling procedure can actually use them, for instance to write them to a vertical range (e.g. starting at cell A7).
Option Explicit ' declaration head of code module
Sub PopulateMonthArray()
'[0] declare array at procedure level
Dim months(11) As String ' equals Dim months(0 to 11)
'Dim months(1 To 12) As String ' alternative: declare a 1-based array
'[1] fill array items with month names passing array as (implicit) ByRef argument
createMonths months ' << call sub createMonths
'[2] write 1-dim array vertically to sheet (transposing output from a "flat" to a 2-dim array)
Sheet1.Range("A7").Resize(Rowsize:=12).Value = Application.Transpose(months)
End Sub
Sub procedure createMonths
As you define a 0-based array months(0 To 11) and months count usually from 1 to 12 I added functionality to allow to create a 1-based array as well.
Sub createMonths(months) ' equals Sub createMonths(ByRef months)
Dim countOffset As Long
countOffset = IIf(LBound(months), 0, 1) ' allow calculation of 0-based AND 1-based arrays
Dim i As Long
For i = LBound(months) To UBound(months) ' loop through each array element
months(i) = Application.Text(DateSerial(0, i + countOffset, 1), "mmmm")
Next i
End Sub
Simple alternative /Edit 2020-05-27
If your intention is, however to make your months array disponible within other procedures without need to declare it in each procedure (neither at a global scope nor within a class definition), you could simply profit from a simple workaround: insert a Property Get usable in standard modules, too - not only available in class modules btw. - But note that you don't preserve ("retain") the array actually, you would rebuild it and possibly in a better readable way.
Public Property Get Months()
Dim tmp(1 To 12) ' I'd prefer a 1-based months array :-)
createMonths tmp ' use the same procedure as above (or rebuild it code)
Months = tmp ' return the Get value
End Property
Sub AnyOtherProcedure()
'no further declaration needed
Debug.Print Months(1) ' ~> January
Debug.Print Join(Months, ", ") ' ~> January, February, ..., December
End Sub
This question already has an answer here:
Search for an element in the VBA ArrayList
(1 answer)
Closed 2 years ago.
I was trying to delete the specific element in the array vba when certain condition are true but i end up getting error 424. May I know the right way to do it? I tired to use redim, however it doesn't suit my condition as after the comparing with others array i need to store the data back into excel file where the location in the excel file is already sorted.
Before changing the remarkRange to array variant, I used it as Dim remarkRange
As Range where I can just use .Clear to clear the range item in a specific element.
I tried remarkRange(I, 1)=" " it runs without error but im not sure if its suitable. May I know the correct way to do it? Thanks.
Dim remarkRange() As Variant
remarkRange= wb.Sheets("wb").Range("A1:A5").Value2
For I = LBound(remarkRange) To UBound(remarkRange)
If (some condition is true) then
remarkRange(I, 1).Delete
End If
Next I
I expected the element in the specific cell in the array to be empty, but I got error 424
An array doesn't have a Delete method. It's also misleading to have the Range in remarkRange when it's an array, not a Range. Maybe a different name, e.g. remarks or whatever is clear to you.
If you're going to write the array back to the worksheet, then I see no problem changing an element to a blank string.
For i = LBound(remarks, 1) To UBound(remarks, 1)
If some condition Then
remarks(i, 1) = ""
End If
Next i
It seems you'll need to decide what you mean by 'delete'. I'm not aware of a Delete property of an array of variants so while your code might compile it would throw an object required error.
However, your point about previously using the Clear method on a Range object, suggests that you just want to read your range values into an array, remove the contents if certain conditions aren't me, and then re-write your array to the range. If that's the case, you probably wouldn't want to resize your array as the rows or columns wouldn't line up - more commonly, you'd set the item of your variant array to Empty.
The code below shows how to do this in a simple routine of taking 10 numbers from column A, removing all odd numbers and re-writing the numbers to Column C - but with the rows still matching:
Public Sub EmptyItemsAndKeepArraySize()
Dim inArr() As Variant
Dim i As Long
'Read range into arrays.
inArr = Sheet1.Range("A1:A10").Value2
'Clear all numbers that are not even.
For i = 1 To UBound(inArr, 1)
If inArr(i, 1) Mod 2 <> 0 Then inArr(i, 1) = Empty
Next
'Write cleared array to column C
Sheet1.Range("c1").Resize(UBound(inArr, 1)).Value = inArr
End Sub
If, however, you really do want to remove and resize your array, then a simple way of doing it is to populate a temporary collection first, resizing an output array and then populating that with the collection items. In the example below the code removes all odd numbers and then writes the array to column B - but as an array reduced in size (ie contiguous rows):
Public Sub DeleteItemsAndShrinkArray()
Dim inArr() As Variant, outArr() As Variant
Dim i As Long
Dim temp As Collection
Dim v As Variant
'Read range into arrays.
inArr = Sheet1.Range("A1:A10").Value2
'Keep all even numbers in a temporary collection.
Set temp = New Collection
For i = 1 To UBound(inArr, 1)
If inArr(i, 1) Mod 2 = 0 Then temp.Add inArr(i, 1)
Next
'Dimension the output array.
ReDim outArr(1 To temp.Count, 1 To 1)
'Populate new array from temp collection.
i = 1
For Each v In temp
outArr(i, 1) = v
i = i + 1
Next
'Write reduced array to column B
Sheet1.Range("B1").Resize(UBound(outArr, 1)).Value = outArr
End Sub
I have a column of data with unique strings where the first 4 characters in the string may be a repeat of the first 4 characters in another string, in a format similar to:
ABCDEF
ABCDXY
ABCDKL
DTYTZF
DTYTSD
I am attempting to loop through this data to identify which 4 starting characters appear more then three times. If the first 4 digits of the string occur 3 times or more, I would like to remove these from the array entirely, and end up with an array that excludes these values. For example, in my column above, as 3 strings or more begin with 'ABCD', I would like to remove all strings that begin with this code, and have only every other value remain, such that my result would be:
DTYTZF
DTYTSD
I am currently looping through the array, pushing any value that occurs three times or more into a NEW array, and plan to then use that list to do a second pass on the original array, and remove any matches. This may not be the most efficient way, but I've not been able to determine a better way that is guaranteed not to mess my data up.
I have worked through looping through the strings to identify which strings occur more then once, but when I try to push them to an array, the string successfully is pushed to the array, but is then replaced with the next value as soon as it is pushed to the array. I know the value is pushed correctly, because if I view the array immediately afterwards, I see the value in the array. When the next value is pushed and you view the array again, only the new value is displayed (The older ones are not).
I believe this is due to my limited understanding of ReDim-ing arrays, and me not fully understanding a code snippet for pushing this value into an array. My (condensed) code is as follows:
Sub pickupValues()
Dim valuesArray()
Dim i As Long
Dim y As Long
Dim sizeCheck As Long
Dim tempArray() As String
valuesArray() = Worksheets("Sheet1").Range("A1:A10").Value
For i = LBound(valuesArray) To UBound(valuesArray)
sizeCheck = 0
For y = LBound(valuesArray) To UBound(valuesArray)
If Left(valuesArray(i, 1), 4) = Left(valuesArray(y, 1), 4) Then
sizeCheck = sizeCheck + 1
i = y
If sizeCheck >= 3 Then
ReDim tempArray(1 To 1) As String 'I'm not sure why I need to do this.
tempArray(UBound(tempArray)) = Left(valuesArray(i, 1), 4) 'I believe this is what pushes the value into the array.
ReDim Preserve tempArray(1 To UBound(tempArray) + 1) As String 'Again unsure on what the purpose of this is.
viewArray (tempArray)
End If
End If
Next y
Next i
End Sub
Function viewArray(myArray)
Dim txt As String
Dim i As Long
For i = LBound(myArray) To UBound(myArray)
txt = txt + myArray(i) + vbCrLf
Next i
MsgBox txt
End Function
What am I doing wrong?
I would like to re-use the same basic code later in the function to push other values OUT of an array based on if they match the string or not, but it seems VBA does not like to move values out of arrays either. Is there an easy solution that would match both scenarios?
I've rewritten what you are trying to do. I'm using the filter function to quickly get your results in the array
Option Explicit
Public Sub pickupValues()
Dim tmp As Variant
Dim results As Variant
Dim i As Long
Dim v
' Make sure this matches your range
With ThisWorkbook.Sheets("Sheet1")
' Important to transpose the input here as Filter will only take a 1D array. Even though it's only 1 column, setting an array this way will generate a 2D array
tmp = Application.Transpose(.Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)).Value2)
End With
' ReDiming to the maximum value and slimming down afterwards is much quicker then increasing your array each time you've found a new value
ReDim results(1 To UBound(tmp))
For Each v In tmp
' Less then 2 as first result is '0'. Will return '-1' if can't be found but as test criteria is in the array it will always be at least 0
If UBound(Filter(tmp, Left(v, 4))) < 2 Then
i = i + 1
results(i) = v
End If
Next v
' Redim Preserve down to actual array size
If i > 0 Then
ReDim Preserve results(1 To i)
viewArray (results)
Else
MsgBox "Nothing Found"
End If
End Sub
' Should really be a sub as doesn't return anything back to caller
Public Sub viewArray(myArray)
MsgBox Join(myArray, vbCrLf)
End Sub
Your algorithm is not helping you.
Option 1:
Sort your array. Then you can make a single pass to find sequential values with the same first four characters and count them.
Option 2:
Use a Dictionary object: first four characters as key, number of occurrences as value.
I know you can easily take a range of cells and slap them into a Variant Array but I want to work with a string array (because it's single-dimensional and takes less memory than a Variant array).
Is there any way to automatically convert a range into a string array?
Right now I am using a function that will take the range and save the values in a variant array, then convert the variant array to a string array. It works nice , but I'm looking for a way to go directly from the range to string array. Any help would be greatly appreciated.
Function RangeToArray(ByVal my_range As Range) As String()
Dim vArray As Variant
Dim sArray() As String
Dim i As Long
vArray = my_range.Value
ReDim sArray(1 To UBound(vArray))
For i = 1 To UBound(vArray)
sArray(i) = vArray(i, 1)
Next
RangeToArray = sArray()
End Function
UPDATE:
It's looking like there is no way to skip the step of throwing the data into a variable array first before converting it to a single-dimensional string array. A shame if it's true (even if it doesn't take much effort, I like to ultra-optimize so I was hoping there was a way to skip that step). I'll close the question in a few days if no solution presents itself. Thanks for the helpful comments, guys!
UPDATE2:
Answer goes to Simon who put in great effort (so did everyone else) and utlimately pointed out it's indeed impossible to go from range to string array in one shot. Thanks, everyone.
You actually can go directly from a range to an array using the functions Split, Join and a delimiter not in the text.
Assuming you have already assigned a 1D range of values as SrcRange
Dim Array() As String: Array = Split(Join(Application.Transpose(SrcRange), "#"), "#")
How about...
Public Function RangeToStringArray(theRange As Excel.Range) As String()
' Get values into a variant array
Dim variantValues As Variant
variantValues = theRange.Value
' Set up a string array for them
Dim stringValues() As String
ReDim stringValues(1 To UBound(variantValues, 1), 1 To UBound(variantValues, 2))
' Put them in there!
Dim columnCounter As Long, rowCounter As Long
For rowCounter = UBound(variantValues, 1) To 1 Step -1
For columnCounter = UBound(variantValues, 2) To 1 Step -1
stringValues(rowCounter, columnCounter) = CStr(variantValues(rowCounter, columnCounter))
Next columnCounter
Next rowCounter
' Return the string array
RangeToStringArray = stringValues
End Function
Function RangeToStringArray(myRange as range) as String()
ReDim strArray(myRange.Cells.Count - 1) As String
Dim idx As Long
Dim c As Range
For Each c In myRange
strArray(idx) = c.Text
idx = idx + 1
Next c
RangeToStringArray = strArray
End Function
If you don't mind altering the contents of the clipboard then:
COPY the range to the clipboard with the Copy method:
MyTargetRange.Copy
Copy the contents from the clipboard to a string variable (search this site or elsewhere for functions to transfer strings to/from the clipboard).
SPLIT the string into a variant array:
MyStringArray = Split(MyClipboardText, vbCrLf)
OPTIONAL: The array will have one additional blank element because there is always an additional Return (vbCrLf) at the end of the text you just copied to the clipboard. To remove simply resize the array:
Redim Preserve MyStringArray(Ubound(MyStringArray) - 1)
Very simple and quick!!!
Drawbacks are that the clipboard may change when you least expect it (during a recalculation) and that it only produces arrays of strings (not Doubles or other numerical value types).
This would be EXTREMELY HELPFUL if you are working with lots of repetitive functions (thousands) that use the same data (thousands of data points). The first time your function is called, do all the intermediate calculations on the ranges of data that you need but save the results in static variables. Also save a string copy of your input ranges via the clipboard. With each subsequent call to your function, convert the input ranges to text, again via the clipboard, and compare with the saved copy. If they are the same you may be able to bypass allot of your preliminary calculations.
Named ranges used in VBA are already arrays. So first make the range into a named range, then refer to it and delete the named range.
For example:
ThisWorkbook.Names.Add Name:="test_array", RefersTo:=Sheet1.Range("A4:B10")
a = Sheet1.Range("test_array")
ThisWorkbook.Names("test_array").Delete