I have a spreadsheet of data that I want to put into a VBA array which then outputs unique values to a new sheet. I have got that to work so far. However, some of the cells in the original data have text separated by commas, and I want to add those to the array as well. I can't quite get that bit to work.
After the various 'dims', my code is
'Grabs the data to work with
Set rTable = Worksheets("Data Entry").Range("N1:N100", "P1:P100")
'Puts it into an array
MyArray = rTable.Value
'Sets where the data will end up
Set rCell = Worksheets("TestSheet").Range("A1:A100")
'Each unique entry gets added to the new array
On Error Resume Next
For Each a In MyArray
UnqArray.Add a, a
Next
'Add unique data to new location
For i = 1 To UnqArray.Count
rCell(i, 1) = UnqArray(i)
Next
I have tried doing a new variant to store the split data
SpArray = split(MyArray,", ")
and then have that here
MyArray = rTable.Value
SpArray = split(MyArray,", ")
and then refer to SpArray for the rest of the code
I've also tried to have as part of
For Each a in SpArray
but it doesn't work for me.
Do I need to do a separate loop on each cell of the array before I filter out the unique ones?
Yes, you need another loop. But if you set a reference to Microsoft Scripting Runtime and use a Dictionary object, you can eliminate the loop that writes to the range because Dictionary.Keys returns an array.
In this example, it attempts to split every entry on a comma and treats each of those as a unique. If there is no comma, Split returns the one value so it works in both cases. There's probably a small cost to splitting things that don't need to be split, but you won't notice until your range is much larger. And it makes the code cleaner, I think.
Sub WriteUniques()
Dim dcUnique As Scripting.Dictionary
Dim vaData As Variant
Dim vaSplit As Variant
Dim i As Long, j As Long
vaData = Sheet1.Range("$I$12:$I$62").Value
Set dcUnique = New Scripting.Dictionary
For i = LBound(vaData, 1) To UBound(vaData, 1)
vaSplit = Split(vaData(i, 1), ",")
For j = LBound(vaSplit) To UBound(vaSplit)
If Not dcUnique.Exists(vaSplit(j)) Then
dcUnique.Add vaSplit(j), vaSplit(j)
End If
Next j
Next i
Sheet1.Range("J12").Resize(dcUnique.Count, 1).Value = Application.Transpose(dcUnique.Keys)
End Sub
The code tweak that worked for me was to put the Split at the end.
'Add unique data to new location
For i = 1 To UnqArray.Count
rCell(i, 1) = Split(UnqArray(i), ",")
Next
This then built up an array using data from different ranges and splitting up comma separated ones before outputting only the unique ones.
Related
So I have an array with a lot of data, I used to write the data to excel sheet via for cycle, but it took too long, so I looked into faster alternatives.
Now I try to display the information with setting a value of range of cells directly to array:
Sub displayRandomMatrix(clientsColl As Collection, resultWorkbook As Workbook)
Dim NamesRange As Range
With resultWorkbook.Worksheets("matrix_random")
...
Set NamesRange = _
.Range(.Cells(2, 1), .Cells(clientsColl.Count + 1, 1))
Dim NamesArray() As String
ReDim NamesArray(1 To clientsColl.Count)
Dim clientRow As Long
Dim simulation As Long
clientRow = 1
simulation = 1
Dim clientCopy As client
For Each clientCopy In clientsColl
For simulation = 1 To clientCopy.getRandomNumbers.Count
...
Next
NamesArray(clientRow) = clientCopy.getClientName
clientRow = clientRow + 1
Next
...
NamesRange.value = NamesArray
...
End With
'debugging
Debug.Print "**************start"
For clientRow = 1 To clientsColl.Count
Debug.Print NamesArray(clientRow)
Next
Debug.Print "**************end"
End Sub
However when I then open a resultWorkbook I see that the same client's name is written in all the needed cells of the 1st column. At the same the debug section of the code produces correct output - there are correct multiple clients names in that array.
So something gets broken when I assign that array to a range: NamesRange.value = NamesArray.
At the same time I do similar thing with other arrays and it works, but this while comes out with the bug.
What might be the reason?
NOTE: clientsColl is a good, correct collection of Clients. There is nothing wrong with it, neither is with resultWorkbook.
NamesArray is a horizontal array, which you are trying to assign to a vertical range. Try using Application.Transpose
NamesRange.value = Application.Transpose(NamesArray)
Transpose is a quick fix but has its limitations. So if that does not work you will need to force a vertical array by declaring a 2nd dimension in your array:
ReDim NamesArray(1 To clientsColl.Count, 1 to 1)
Then when you fill it make sure to include the second dimension:
NamesArray(clientRow,1) = clientCopy.getClientName
Then you can assign it as you have:
NamesRange.value = NamesArray
I am using an array to process the values (and texts) I have in a sheet:
Dim arr As Variant
arr = Application.ActiveSheet.UsedRange
'do stuff
Application.ActiveSheet.UsedRange = arr
However, this has a side-effect: when dumping the array back into the cells, the cells formatting is changed by Excel's default behaviour. For example, numbers stored as text which start with "0" are converted to numbers, and the "0" gets deleted. Or texts like "1-11" are converted to dates ("November 1"); and probably some others which I have not spotted yet.
If I monitor the Locals window, the strings are being preserved as strings in the array until the very moment, so it is the unloading that messes things up.
Is there a way to avoid this behavior ?
Edit: I also tried:
Application.ActiveSheet.UsedRange.Value = arr
Application.ActiveSheet.UsedRange.Value2 = arr
Application.ActiveSheet.UsedRange.text = arr
Same result for each.
You can use the valuetype option to preserve formatting etc: 11 is xlRangeValueXMLSpreadsheet
Sub CopyWithFormat()
Dim var As Variant
var = Range("A8:A11").Value(11)
Range("C8:C11").Value(11) = var
End Sub
But that will make it difficult to modify the values in the array.
So its probably simplest to loop the array adding '
Sub CopyWithFormat2()
Dim var As Variant
Dim j As Long
var = Range("A8:A11").Value
For j = 1 To UBound(var)
If VarType(var(j, 1)) = vbString Then var(j, 1) = "'" & var(j, 1)
Next j
Range("C8:C11").Value = var
End Sub
Also try
YourRangeVariable.NumberFormat = "#"
YourRange.Value=Your Array
This will convert the range to text first. Works for me when using values like 01-11 and saves having to do a loop.
As a beginner to VBA I'm trying to learn most of this content ad-hoc, so pardon my dust.
I have a subroutine I'm writing for reading through lines in a text file. Each line is space delimited with ' as a text identifier. I require each line to be split into fields as a multidimensional array.
Sub ReadLines()
Dim LineValues() As String
Dim row As Long, col As Long
Dim DataArray() As String
Dim TempArray() As String
Dim FileContent As String
Dim FilePath As String
FilePath = "c:\mytextfile.txt"
row = 0
TextFile = FreeFile
Open FilePath For Input As TextFile
FileContent = Input(LOF(TextFile), TextFile)
Close TextFile
LineValues = Split(FileContent, vbCrLf)
For X = LBound(LineValues) To UBound(LineValues)
If Len(Trim(LineValues(X))) <> 0 Then
DataArray = Split(LineValues(X), "'")
col = UBound(DataArray)
TempArray = DataArray
ReDim DataArray(col, row)
For i = LBound(TempArray) To UBound(TempArray)
DataArray(i, row) = TempArray(i)
Next i
End If
row = row + 1
Next X
I came to this bit of code after struggling against the multidimensional problems with ReDim Preserve. (only being able to modify the last dimension) The multidimensional array in my text file will have unknown columns and rows depending on user input.
This code does the process correctly...but just can't store the array elements correctly! The intent above was to use a temporary array (TempArray) while I ReDim (and empty) the array I am interested in (DataArray) and then copy back the elements originally from DataArray into the resized dimensions.
However when stepping through the code I can see each row being placed correctly but then erased with each iteration at line,
DataArray = Split(LineValues(X), "'")
I essentially have a matrix that is sized by the total number of rows but only by the number of columns on the last row (and only the values from the last row) as a result of this.
I realise why this is happening but can anyone here propose a solution? As a beginner this is all a bit maddening!
EDIT, Full Problem Description
To clarify fully, this is a subroutine I will call as part of a script reading through a text file which contains irrelevant data. This text file looks a little something like this, (vagueness of the references is intentional)
'<irrelevant text I want to ignore until seeing pattern 'NumberOfVariables?'>
...
...
NumberOfVariables?
NUMBEROFVARIABLES
'for the end user, I need to be able to pull information from each of these fields assigned to a variable to create strings as headers as per a specific format
'note that variable and variable type
Variable#1 VARIABLETYPE Location? LOCATION UNITS DESCRIPTION 'text for each field is enclosed as follows '' (code formatting on site prevents me doing this)
Variable#2 VARIABLETYPE Location? LOCATION UNITS DESCRIPTION
...
Variable#NUMBEROFVARIABLES
' from here there is a column of data that is assigned to each variable such that
Variable#1Element1 Variable#2Element1 'etc until #NUMBEROFVARIABLES
Variable#1Element2 Variable#2Element2
Variable#1Element3 Variable#2Element3
Variable#1FinalElement Variable#2FinalElement
Main goal is use the script in original post to get these fields in a multidimensional matrix that I can then use against some conditional statements to get the header strings as per the end user desires.
From here I would then find a way to have the columns of data match up with each variable such that it can be automated into Excel.
A step further would be some sort of MsgBox w/ a pulldown that would select variables to copy across but that's pie in the sky thinking at my stage of development right now!
Try this. I've not tested it:
Sub ReadLines()
Const FilePath$ = "c:\mytextfile.txt"
Dim iFile%, c&, i&, j&, k&, Content$, Lines, Temp, Data
c = 499
Open FilePath For Input As #iFile
Content = StrConv(InputB(LOF(iFile), iFile), vbUnicode)
Close #iFile
Lines = Split(Content, vbCrLf)
ReDim Data(0 To UBound(Lines), 0 To c)
For i = 0 To UBound(Lines)
If Len(Trim$(Lines(i))) Then
Temp = Split(Lines(i), "'")
If k < UBound(Temp) Then k = UBound(Temp)
If k > c Then
c = k * 2
ReDim Preserve Data(0 To UBound(Lines), 0 To c)
End If
For j = 0 To UBound(Temp)
Data(i, j) = Temp(j)
Next
End If
Next
ReDim Preserve Data(0 To UBound(Lines), 0 To k)
End Sub
I require each line to be split into fields as a multidimensional array.
Well I don't know if this is actually true, because i'm not sure what you're ultimately doing with the data, but in any case, a super simple alternative would be to read the .txt file in to a workbook structure.
To do this, use the Workbooks.OpenText method with parameter: TextQualifier:=xlTextQualifierSingleQuote (there are some additional optional parameters which may be needed depending on your use-case).
This should open the text file, properly delimited, in to the "fields" (Columns in the worksheet).
From there, you can assign the sheet's UsedRange.Value to a variant array.
I have a list of arrays. I am looping through to write the data in the arrays into a text file. When I loop through each time, I would like to use a different array to access the data.
I am thinking of storing the names of these arrays in an different array and as I loop through, I can access this array using the current loop index. But I am not sure how to do this in VBA.
Need some guidance on this. I am welcome to other suggestions as well.
You could also store them in a collection. This will also allow you to add a key to each array that you store in the collection. You can than even call a specific array using this key. Just a short example to get you started:
Sub CreateCollection()
Dim col As Collection
Dim arr As Variant
Dim MyArray1(1) As String
Dim MyArray2(1) As String
MyArray1(0) = "FirstItemArr1"
MyArray1(1) = "SecondItemArr1"
MyArray2(0) = "FirstItemArr2"
MyArray2(1) = "SecondItemArr2"
Set col = New Collection
col.Add MyArray1, "ArrayName1"
col.Add MyArray2, "ArrayName2"
For Each arr In col
Debug.Print arr(1)
Next
Debug.Print col("ArrayName2")(1)
Set col = Nothing
End Sub
I have a list of customers from last year (in column A) and I have a list of customers from this year (in Column B). I've put the data from these two columns in arrays (using the code below - which is set up as Option Base 1):
'Define our variables and array types'
Sub CustomerArray()
Dim LastArray() As String
Dim CurrentArray() As String
Dim BothArray() As String
Dim LR As Long
Dim i As Integer
'Define LastArray which is customers last year'
LR = Cells(Rows.Count, 1).End(xlUp).Row
ReDim LastArray(LR - 3)
With Range("A1")
For i = 1 To LR - 3
LastArray(i) = .Offset(i, 0)
Next i
End With
'Define CurrentArray which is customers this year'
ReDim CurrentArray(LR - 3)
With Range("B1")
For i = 1 To LR - 3
CurrentArray(i) = .Offset(i, 0)
Next i
End With
End Sub
Now I want to compare/combine the Arrays to show a list of customers who appear in both of the two arrays I just defined (last year and this year). I want to create a third array with the customers who appear for both years (and I want to put that in column D of my excel sheet). I'm getting confused on how to write the code which will compare these two arrays (current year and last year). Will I use a conditional If > statement? Each of the arrays have the customers listed alphabetically.
I appreicate any help you might be able to give me.
Thanks!
You don't need to mess with arrays or loop at all, keep it simple, try something like this:
Sub HTH()
With Range("A1", Cells(Rows.Count, "A").End(xlUp)).Offset(, 3)
.Formula = "=IF(COUNTIF(B:B,A1)>0,A1,"""")"
.Value = .Value
.SpecialCells(xlCellTypeBlanks).Delete
End With
End Sub
OK. I got a little carried away here, but this does what your are asking (you may have to tune it up to suit your specific needs. To use this code, simply call the Sub "Match Customers".
Your original code proposed the use of three arrays. Excel VBA provides some mechanisms to do what you seek which are both easier to use, and possibly more efficient.
I went ahead and broke the process out into more discrete chunks of code. While it seems like more code, you will find that each peice might make more sense, and it is much more maintainable. You can also now re-use the individual functions for other operations if needed.
I also pulled your range and column indexes out into locally defined constants. This way, if the various row or column references ever need to change, you only have to change the value in one place.
It is not necessarily the most efficient way to do this, but is most likely less complicated than using the arrays you originally propose.
I have not tested this exhaustively, but it works in the most basic sense. Let me know if you have questions.
Hope that helps . . .
Option Explicit
'Set your Column indexes as constants, and use the constants in your code.
'This will be much more maintainable in the long run:
Private Const LY_CUSTOMER_COLUMN As Integer = 1
Private Const CY_CUSTOMER_COLUMN As Integer = 2
Private Const MATCHED_CUSTOMER_COLUMN As Integer = 4
Private Const OUTPUT_TARGET As String = "D1"
Private Const LAST_ROW_OFFSET As Integer = -3
'A Function which returns the list of customers from last year
'as a Range object:
Function CustomersLastYear() As Range
Dim LastCell As Range
'Find the last cell in the column:
Set LastCell = Cells(Rows.Count, LY_CUSTOMER_COLUMN).End(xlUp)
'Return the range of cells containing last year's customers:
Set CustomersLastYear = Range(Cells(1, LY_CUSTOMER_COLUMN), LastCell)
End Function
'A Function which returns the list of customers from this year
'as a Range object:
Function CustomersThisYear() As Range
Dim LastCell As Range
'Find the last cell in the column:
Set LastCell = Cells(Rows.Count, CY_CUSTOMER_COLUMN).End(xlUp)
'Return the range of cells containing this year's customers:
Set CustomersThisYear = Range(Cells(1, CY_CUSTOMER_COLUMN), LastCell)
End Function
'A function which returns a range object representing the
'current list of matched customers (Mostly so you can clear it
'before re-populating it with a new set of matches):
Function CurrentMatchedCustomersRange() As Range
Dim LastCell As Range
'Find the last cell in the column:
Set LastCell = Cells(Rows.Count, MATCHED_CUSTOMER_COLUMN).End(xlUp)
'Return the range of cells containing currently matched customers:
Set CurrentMatchedCustomersRange = Range(Cells(1, MATCHED_CUSTOMER_COLUMN), LastCell)
End Function
'A Function which performs a comparison between two ranges
'and returns a Collection containing the matching cells:
Function MatchedCustomers(ByVal LastYearCustomers As Range, ByVal ThisYearCustomers As Range) As Collection
Dim output As Collection
'A variable to iterate over a collection of cell ranges:
Dim CustomerCell As Range
'Initialize the collection object:
Set output = New Collection
'Iterate over the collection of cells containing last year's customers:
For Each CustomerCell In LastYearCustomers.Cells
Dim MatchedCustomer As Range
'Set the variable to reference the current cell object:
Set MatchedCustomer = ThisYearCustomers.Find(CustomerCell.Text)
'Test for a Match:
If Not MatchedCustomer Is Nothing Then
'If found, add to the output collection:
output.Add MatchedCustomer
End If
'Kill the iterator variable for the next iteration:
Set MatchedCustomer = Nothing
Next
'Return a collection of the matches found:
Set MatchedCustomers = output
End Function
Sub MatchCustomers()
Dim LastYearCustomers As Range
Dim ThisYearCustomers As Range
Dim MatchedCustomers As Collection
Dim MatchedCustomer As Range
'Clear out the destination column using the local function:
Set MatchedCustomer = Me.CurrentMatchedCustomersRange
MatchedCustomer.Clear
Set MatchedCustomer = Nothing
'Use local functions to retrieve ranges:
Set LastYearCustomers = Me.CustomersLastYear
Set ThisYearCustomers = Me.CustomersThisYear
'Use local function to preform the matching operation and return a collection
'of cell ranges representing matched customers. Pass the ranges of last year and this year
'customers in as Arguments:
Set MatchedCustomers = Me.MatchedCustomers(LastYearCustomers, ThisYearCustomers)
Dim Destination As Range
'Use the local constant to set the initial output target cell:
Set Destination = Range(OUTPUT_TARGET)
'Itereate over the collection and paste the matches into the output cell:
For Each MatchedCustomer In MatchedCustomers
MatchedCustomer.Copy Destination
'Increment the output row index after each paste operation:
Set Destination = Destination.Offset(1)
Next
End Sub
If you want to compare the two arrays using loops, maybe because you have, for example, picked up all the data into arrays for faster computation rather than interacting with the spreadsheet range object, or you need to compare multiple things from the two arrays to check that the entries match so can't use a .find statement, then this is what you need:
-Two loops, one nested inside the other
-Three counters, one for each array
-One "Exit Loop", "Exit For", "GoTo foundmatch" or similar way of exiting the inner loop
-A "Redim Preserve" of the results array
-An "If" statement
-Finally, one line where you assign the name that appears in both arrays to the results array
This is everything that is needed to write it simply as loops - but doesn't give the fastest or best way to do it (Redim Preserve is not the best..). Constructing it should be easy from this list though: the if statement should either be an x=y type for a general usage, or if x>y if you are really really sure that the list being looped in the inner loop really is sorted alphabetically