I am trying to store an array of unique string values from a certain column. However I can't seem to be able to access the values in the array while the code is running. Would you be able to tell me what additional line of code would I need, to check what is being stored in the array when it is in fact running, and eventually copy those unique values to another sheet? Code below:
Find unique values in Column END DATE so to check whether multiple dates need to be imported:
Sub Find_Unique_Values()
Dim PaceData(), UniqueValues As Variant, r As Long
With PaceDataSheet
PaceData = .UsedRange.value
Set UniqueValues = CreateObject("Scripting.Dictionary")
For r = 2 To UBound(PaceData)
UniqueValues(PaceData(r, datecolumn.Column)) = Empty
Next r
End With
End Sub
Any help is super appreciated. Thanks very much!
However I can't seem to be able to access the values in the array while the code is running. - here is a way to do this easily, using .UsedRange, as in your code:
Option Explicit
Sub TestMe()
Dim PaceData As Variant
Dim someRange As Range
Set someRange = Worksheets(1).UsedRange 'A1:C10
PaceData = someRange
Dim myRows As Long: myRows = someRange.Rows.Count
Dim myCol As Long: myCol = someRange.Columns.Count
Dim cnt1 As Long
Dim cnt2 As Long
For cnt1 = 1 To myRows
For cnt2 = 1 To myCol
Debug.Print PaceData(cnt1, cnt2)
Next cnt2
Next cnt1
End Sub
The UsedRange is "translated" as a 2-dimensional array like this:
and knowing the Rows.Count and the Columns.Count of the passed range, we get the dimensions.
Related
I have seen multiple codes regarding this topic but I can't seem to understand it.
For instance, if I have a column that records people names, I want to record all unique names into the array.
So if I have a column of names
David
Johnathan
Peter
Peter
Peter
Louis
David
I want to utilize VBA to extract unique names out of the column and place it into an array so when I call the array it would return these results
Array[0] = David
Array[1] = Johnathan
Array[2] = Peter
Array[3] = Louis
Despite a Collection being mentioned and being a possible solution, it is far more efficient to use a Dictionary as it has an Exists method. Then it's just a matter of adding the names to the dictionary if they don't already exist, and then extracting the keys to an array when you're done.
Note that I've made the name comparisons case-sensitive, but you can change that if necessary, to case-insensitive.
Option Explicit
Sub test()
'Extract all of the names into an array
Dim values As Variant
values = Sheet1.Range("Names").Value2 'Value2 is faster than Value
'Add a reference to Microsoft Scripting Runtime
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
'Set the comparison mode to case-sensitive
dic.CompareMode = BinaryCompare
Dim valCounter As Long
For valCounter = LBound(values) To UBound(values)
'Check if the name is already in the dictionary
If Not dic.Exists(values(valCounter, 1)) Then
'Add the new name as a key, along with a dummy value of 0
dic.Add values(valCounter, 1), 0
End If
Next valCounter
'Extract the dictionary's keys as a 1D array
Dim result As Variant
result = dic.Keys
End Sub
use Dictionary object and build a Function that returns your array
Function GetUniqeNames(myRng As Range) As Variant
Dim cell As Range
With CreateObject("Scripting.Dictionary") ' instantiate and reference a Dictionary object
For Each cell In myRng ' loop through passed range
.Item(cell.Value2) = 1 ' store current cell name into referenced dictionary keys (duplicates will be overwritten)
Next
GetUniqeNames = .keys ' write referenced dictionary keys into an array
End With
End Function
that you can exploit in your main code as follows
Sub main()
Dim myArray As Variant
With Worksheets("mysheet") ' change "mysheet" to your actual sheet name
myArray = GetUniqeNames(.Range("A1", .Cells(.Rows.Count, 1).End(xlUp))) ' this will take the referenced sheet column A range from row 1 down to last not empty one
End With
End Sub
Is this a VBA question or a question about programming logic? Use a loop on the column with the data. Check each name against the list of existing data items. If it exists in the list, move on the the next name. If it does not exist in the list, add it.
The "list" is a concept, not a concrete tool. It can be a VBA dictionary, if you are comfortable using that. Or it can be a VBA array, which may not perform as fast as a dictionary, but may be more familiar.
Then again, if you add the data to the Excel Data Model, you can use the Distinct aggregation of a pivot table to list out the unique values.
Without more background it's hard to tell if VBA or Data Model is your best approach. Many VBA solutions get created because people are not aware of Excel's capabilities.
You could use Excel functionality like that.
Sub UniqueNames()
Dim vDat As Variant
Dim rg As Range
Dim i As Long
Set rg = Range("A1:A7")
rg.RemoveDuplicates Columns:=Array(1), Header:=xlNo
With ActiveSheet
vDat = WorksheetFunction.Transpose(.Range("A1:" & .Range("A1").End(xlDown).Address))
End With
For i = LBound(vDat) To UBound(vDat)
Debug.Print vDat(i)
Next i
End Sub
Code is based on your example data, i.e. I put your data into column 1. But the code will also alter the table. If you do not want that you have to use other solutions or put the data beforehand in a temporary sheet.
If you dont want to use "Scripting.Dictionary" and your excel does not have Worksheet.unique(...) like mine
Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
If UBound(arr) >= 0 Then
IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
Else
IsInArray = False
End If
End Function
Public Function GetUniqueValuesFromColumn(ws As Worksheet, sourceColNum As Long, Optional firstRow As Long = 2) As Variant
Dim val As String
Dim i As Long
Dim arr() As Variant
arr = Array()
For i = firstRow To ws.Cells(Rows.Count, sourceColNum).End(xlUp).Row
val = ws.Cells(i, sourceColNum)
If Not IsInArray(val, arr) Then
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = val
End If
Next i
GetUniqueValuesFromColumn = arr
End Function
Then call it like GetUniqueValuesFromColumn(ThisWorkbook.Worksheets("SomeList"), 1)
I am trying to populate a one column table in excel which I can connect to power query, using vba and a one dimensional array.
So the user puts a list into a textbox where each item is seperated by a semicolon, then it brings that into the array. So far I have :
Dim arrSIOCodes As Variant
arrSIOCodes = Split(tbSIOCodes, ";")
ThisWorkbook.Sheets("CAEATFA_SIO").Activate
Call ChangeTableToArray(tbl:=ThisWorkbook.Sheets("CAEATFA_SIO").ListObjects("tblSIOCodes"), ar:=arrSIOCodes)
and I got this sub from another stack overflow post but I need to customize it to my issue and I am having trouble
Sub ChangeTableToArray(tbl As ListObject, ar)
Dim newRows As Long: newRows = 1 + UBound(ar, 1) - LBound(ar, 1)
If Not tbl.DataBodyRange Is Nothing Then tbl.DataBodyRange.EntireRow.Delete
If newRows > 1 Then tbl.HeaderRowRange.Resize(newRows - 1).Offset(2).EntireRow.Insert
tbl.HeaderRowRange.Resize(newRows, 1 + UBound(ar, 1) - LBound(ar, 1)).Offset (1).value = ar
End Sub
This is what the current code is doing:
however this is what I need it to do:
You are resizing the number of columns in the destination, but you only have one column (if you Transpose the array) to store. So do something like:
tbl.HeaderRowRange.Resize(newRows, 1).Offset (1).value = Application.Transpose(ar)
About to go into a late meeting, so I threw this together quickly and it's untested. But this is just another way to look at it:
Sub ArrayToTable(ByVal ws As Worksheet, ParamArray YourArr() As Variant)
Dim TmpArr As Variant, i As Long, LineNum As Long
TmpArr = YourArr(0)
LineNum = 1 'whatever method you use to find linenumbers
For i = LBound(TmpArr) To UBound(TmpArr)
ws.Cells(LineNum, 1).Value = TmpArr(i)
LineNum = LineNum + 1
Next
End Sub
I am trying to calculate the count of Unique values based on a condition.
For example,
For a value in column B, I am trying to count the Unique values in Column C through VBA.
I know how to do it using Excel formula -
=SUMPRODUCT((B2:B12<>"")*(A2:A12=32)/COUNTIF(B2:B12,B2:B12))
that value for 32 is dynamic - Programmatically I am calling them inside my vba code as Name
This is my code :
Application.WorksheetFunction.SumProduct((rng <> "") * (rng2 = Name) / CountIfs(rng, rng))
This is the sample data with the requirement
Alternatively, I Concatenated both the columns for keeping it simple and hoping to identify the Unique values which starts with name* method.
I don't know where I am going wrong. Kindly share your thoughts.
You may try something like this...
Function GetUniqueCount(Rng1 As Range, Lookup As String) As Long
Dim x, dict
Dim i As Long, cnt As Long
Set dict = CreateObject("Scripting.Dictionary")
x = Rng1.Value
For i = 1 To UBound(x, 1)
If x(i, 1) = Lookup Then
dict.Item(x(i, 1) & x(i, 2)) = ""
End If
Next i
GetUniqueCount = dict.Count
End Function
Then you can use it like below...
=GetUniqueCount($A$2:$B$10,C2)
Where A2:B10 is the data range and C2 is the name criteria.
I'd put the values into an array, create a temporary 2nd array and only add values to this array if they are not already present, and then replace the original array. Then it's just a simple matter to sum the unique values:
Sub Unique
dim arr(10) as variant, x as variant
dim arr2() as variant
for x = 1 to 10 ' or whatever
arr(x) = cells(x, 1) ' or whatever
next x
arr2 = UniqueValuesArray(arr)
' now write some code to count the unique values, you get the idea
End Sub
Function UniqueValuesArray(arr As Variant) As Variant()
Dim currentRow, arrpos As Long
Dim uniqueArray() As Variant
Dim x As Long
arrpos = 0
ReDim uniqueArray(arrpos)
For x = 0 To UBound(arr)
If UBound(Filter(uniqueArray, arr(x))) = -1 Then
ReDim Preserve uniqueArray(arrpos)
uniqueArray(arrpos) = arr(x)
arrpos = arrpos + 1
End If
Next x
UniqueValuesArray = uniqueArray
End Function
I currently have a method which takes in a dynamic named range in excel and converts it to a 2D array.
I need to do some iterations to the data and carry out a Delete function if a certain column contains a value. I have looked at the options out there for deleting rows in 2d array using transpose and temp array and since my data is fairly large I am looking at other data structures that would make it easier to delete entire rows.
I want to convert a dynamic named range into a collection in vba. This collection will have a key the row number and as item should have all the data for that row. Basically I would need the ability to iterate through each value in that range like I can do with a 2D array but also the ability to delete a row efficiently and with less hassle than using a 2D array.
Anybody have an idea on how I can achieve this?
Dim srcArray () As Variant
Dim srcRange As Range
srcRange = ThisWorkbook.Worksheets("Main").Range("myNamedRange")
srcArray = srcRange.Value
Dim rowNr As Long
dim colNr As Long
for rowNr = 1 to UBound(srcArray,1)
if srcArray(rowNr, 9) = "testString" Then Call DeleteRowSub(srcArray, rowNr)
Next rowNr
DeleteRowSub will be a sub which will delete a given row based on the index of that row. I want to get away from that and just be able to say something like srcCollection.Remove(index) with index being the row nr.
Any help, greatly appreciated.
There's no secret to this. It's just housekeeping.
Function ReadRangeRowsToCollection(r As Range) As Collection
Dim iRow As Long
Dim iCol As Long
Dim rangeArr As Variant
Dim rowArr As Variant
Dim c As Collection
'Read range content to Variant array
rangeArr = r.Value
'Now transfer shit to collection
Set c = New Collection
For iRow = 1 To r.Rows.Count
ReDim rowArr(1 To r.Columns.Count)
For iCol = 1 To r.Columns.Count
rowArr(iCol) = rangeArr(iRow, iCol)
Next iCol
c.Add rowArr, CStr(iRow)
Next iRow
Set ReadRangeRowsToCollection = c
End Function
Example usage:
Dim c As Collection
Set c = ReadRangeRowsToCollection(Range("myNamedRange"))
c.Remove 1 ' remove first row from collection
Note: I haven't looked at edge cases; for example this will fail if the range is one cell only. Up to you to fix it.
I am trying to write a code that reads in multiple entities, catorgorizes and sorts them. Each entity has a type (A, B, C, etc.) that should determine what sheet it gets put into and all of them get put into my "All" sheet. Each time I find an entity of any given type I'd also like to increment a variable specific to that type.
What I'd like to do if find the type and do two things:
Set the current sheet to that type.
Set the counter variable to that type.
Example:
Dim x As Integer, FindSlot As Integer
Dim CurrentSheet As String, CurrentPropertyNumb As String
Dim APropertyNumb As String, BPropertyNumb As String
Dim CPropertyNumb As String
For x = 1 to 2
If x = 1 Then
CurrentSheet = "All"
Else
CurrentSheet = Range("B" & FindSlot)
CurrentPropertyNumb = CurrentSheet & PropertyNumb
End If
Next x
In the else block, CurrentSheet will get set to "A", "B", "C" or whatever the type is. Then I'd like CurrentPropertyNumb to get set to "APropertyNumb" or "BPropertyNumb" etc. Obviously I could do this with several If statements but it would end up being 12 of them which I'd rather avoid plus I think this would be cool! :)
Is there any way to do this or am I being too lofty with my goals?
If you have a series of values which you'd like to index using a string value then a Dictionary is a good fit:
Dim x As Integer, FindSlot As Integer
Dim CurrentSheet As String, CurrentPropertyNumb As String
Dim PropNums as Object
Dim CPropertyNumb As String
Set PropNums = CreateObject("scripting.Dictionary")
For x = 1 to 2
If x = 1 Then
CurrentSheet = "All"
Else
CurrentSheet = Range("B" & FindSlot)
If Not PropNums.Exists(CurrentSheet) Then
PropNums.Add CurrentSheet, 1 '? what are the initial values here?
Else
PropNums(CurrentSheet) = PropNums(CurrentSheet) +1
End If
CurrentPropertyNumb = PropNums(CurrentSheet)
End If
Next x