Was searching for a while, but cannot find a proper answer. I working on a variant and I used a solution provided below:
http://www.mrexcel.com/forum/excel-questions/305870-eliminate-duplicated-visual-basic-applications-array.html
So what I have is basically a variant which then beeing redimed without duplicates. It works fine if you use just one column from sheet so the variant variable has only 1 column as well.
The data I'm working on needs to be checked for 2 columns, while in the for each loop I would like to refer only to 2nd column:
Dim mgNames As Variant
Range(Cells(1, "I"), Cells(Range("a1").End(xlDown).Row, "J")).Select
mgNames = Selection
Dim myCollection As New Collection
Dim temp As Variant
On Error Resume Next
For Each temp In mgNames
myCollection.Add Item:=temp, Key:=temp
Next temp
On Error GoTo 0
ReDim mgNames(1 To myCollection.Count)
For temp = 1 To myCollection.Count
mgNames(temp) = myCollection(temp)
Next temp
so in part For Each temp In mgNames code takes each value in variant, ex mgnames(1,1) then mgnames(1,2) and so on. I would like to iterate this only for 2nd column, so from (1,2) (2,2), (3,2)...
If anyone is able to help with this it would be great
You don't have to loop through the array with For Each, you can use a normal For, as in
Dim i As Long
...
For i = LBound(mgNames,1) To Ubound(mgNames,1)
myCollection.Add Item:=mgNames(i,2), Key:=mgNames(i,2)
Next i
...
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 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 have a table structured (Table Name: Table2) like below:
Using VBA, I want to select ONLY a single column value of the current row by iterating over each row.
Here is the code and I wrote:
Function findColumnValue(strColCombIdent As String, strColumnName As String) As String
On Error Resume Next
Dim strRetResult As String
Dim wsMapMasterRefSheet As Worksheet
'Referes to the table Table2.
Dim loMapMaster As ListObject
Set wsMapMasterRefSheet = ThisWorkbook.Worksheets("Sheet3")
Set loMapMaster = wsMapMasterRefSheet.ListObjects("Table2")
'All rows of the table Table2
Dim rAllRows As Range
Set rAllRows = loMapMaster.DataBodyRange
'Holds one row from the databody range for processing.
Dim rCurrRow As Range
'Process data
Dim strTemp As String
For Each rCurrRow In rAllRows
strTemp = rCurrRow.Columns(2)
Debug.Print strTemp
Next rCurrRow
findColumnValue = strRetResult
End Function
I was hoping to get results like below (ONLY the value of the column 2):
1.5
1.5
1.8
4
3
3
1
2
10
12
5
7
Instead I end up with something like this (All values from column#2 onwards, for each processing row.)
1.5
0.045150462962963
1.5
4.52083333333333E-02
1.8
4.72685185185185E-02
4
0.168090277777778
3
3.1
3
8.47800925925926E-02
1
4.16666666666667E-02
2
8.33449074074074E-02
10
10.1.1.1
12
1.3.4.5
5
0.212511574074074
7
8.54166666666667E-02
Using
strTemp = rCurrRow.Columns(1, 2)
instead of
strTemp = rCurrRow.Columns(2)
Causes runtime error 1004
Since each iteration points to a range object in the For loop; I was thinking using
rCurrRow.Columns(2)
will point to current Row's column#2 and hence print out only the column's value.
Is my logic misplaced?
One additional question:
Why does the MSDN Excel Reference guide describes Columns as a Property; where as clearly the "Columns" usage clearly takes parameters
Here is the link I referred:
http://msdn.microsoft.com/en-us/library/office/ff197454(v=office.15).aspx
Either specify you want to iterate rows:
For Each rCurrRow In rAllRows.Rows
or only look at the ListRows in the first place:
Function findColumnValue(strColCombIdent As String, strColumnName As String) As String
On Error Resume Next
Dim strRetResult As String
Dim wsMapMasterRefSheet As Worksheet
'Referes to the table Table2.
Dim loMapMaster As ListObject
Set wsMapMasterRefSheet = ThisWorkbook.Worksheets("Sheet3")
Set loMapMaster = wsMapMasterRefSheet.ListObjects("Table2")
'All rows of the table Table2
Dim rAllRows As ListRows
Set rAllRows = loMapMaster.ListRows
'Holds one row from the databody range for processing.
Dim rCurrRow As ListRow
'Process data
Dim strTemp As String
For Each rCurrRow In rAllRows
strTemp = rCurrRow.Range(, 2)
Debug.Print strTemp
Next rCurrRow
findColumnValue = strRetResult
End Function
You can call your variable rCurrRow all you want; VBA still won't know that you mean for it to contain an entire row of range rAllRows. It just assumes that rCurrRow represents one cell, such that For Each rCurrRow In rAllRows means "for each individual cell in this range".
What you need to do is limit the range being looped through. This should work; not tested.
For Each rCurrRow In rAllRows.Columns(2)
strTemp = rCurrRow
Debug.Print strTemp
Next rCurrRow
In fact I wouldn't call that variable rCurrRow at all; if you're going to use it in this way, call it e.g. cell instead.
EDIT: now that you have clarified your question in a comment below, you could do this:
For i = 1 To rAllRows.Rows.Count
Set rCurrRow = rAllRows.Rows(i)
strTemp = rCurrRow.Cells(1,2)
Debug.Print strTemp
Next i
But even better and faster would be to load the entire range to a two-dimensional Variant array at once, and loop over that array — much faster than looping over many cells.
Dim v As Variant
v = rAllRows ' load entire range to a 2D array
For i = 1 To UBound(v,1)
strTemp = v(i,2)
Debug.Print strTemp
Next i
Why does the MSDN Excel Reference guide describes Columns as a Property; where as clearly the "Columns" usage clearly takes parameters
Both methods and properties can take parameters. The distinction is more or less as follows:
Properties are things that you can get (like a range's Address, which takes no parameter, or subrange such as Column or Row or Cells, which do) and/or set (like a range's .Interior.Color, or .Hidden status). They are usually nouns.
Methods are things that do something to/with the range, and as such are usually verbs. Like .Select (takes no parameters) or .Copy (takes one parameter) or even .Speak.
I have worked in Python earlier where it is really smooth to have a dictionary of lists (i.e. one key corresponds to a list of stuff). I am struggling to achieve the same in vba. Say I have the following data in an excel sheet:
Flanged_connections 6
Flanged_connections 8
Flanged_connections 10
Instrument Pressure
Instrument Temperature
Instrument Bridle
Instrument Others
Piping 1
Piping 2
Piping 3
Now I want to read the data and store it in a dictionary where the keys are Flanged_connections, Instrument and Piping and the values are the corresponding ones in the second column. I want the data to look like this:
'key' 'values':
'Flanged_connections' '[6 8 10]'
'Instrument' '["Pressure" "Temperature" "Bridle" "Others"]'
'Piping' '[1 2 3]'
and then being able to get the list by doing dict.Item("Piping") with the list [1 2 3] as the result. So I started thinking doing something like:
For Each row In inputRange.Rows
If Not equipmentDictionary.Exists(row.Cells(equipmentCol).Text) Then
equipmentDictionary.Add row.Cells(equipmentCol).Text, <INSERT NEW LIST>
Else
equipmentDictionary.Add row.Cells(equipmentCol).Text, <ADD TO EXISTING LIST>
End If
Next
This seems a bit tedious to do. Is there a better approach to this? I tried searching for using arrays in vba and it seems a bit different than java, c++ and python, with stuft like redim preserve and the likes. Is this the only way to work with arrays in vba?
My solution:
Based on #varocarbas' comment I have created a dictionary of collections. This is the easiest way for my mind to comprehend what's going on, though it might not be the most efficient. The other solutions would probably work as well (not tested by me). This is my suggested solution and it provides the correct output:
'/--------------------------------------\'
'| Sets up the dictionary for equipment |'
'\--------------------------------------/'
inputRowMin = 1
inputRowMax = 173
inputColMin = 1
inputColMax = 2
equipmentCol = 1
dimensionCol = 2
Set equipmentDictionary = CreateObject("Scripting.Dictionary")
Set inputSheet = Application.Sheets(inputSheetName)
Set inputRange = Range(Cells(inputRowMin, inputColMin), Cells(inputRowMax, inputColMax))
Set equipmentCollection = New Collection
For i = 1 To inputRange.Height
thisEquipment = inputRange(i, equipmentCol).Text
nextEquipment = inputRange(i + 1, equipmentCol).Text
thisDimension = inputRange(i, dimensionCol).Text
'The Strings are equal - add thisEquipment to collection and continue
If (StrComp(thisEquipment, nextEquipment, vbTextCompare) = 0) Then
equipmentCollection.Add thisDimension
'The Strings are not equal - add thisEquipment to collection and the collection to the dictionary
Else
equipmentCollection.Add thisDimension
equipmentDictionary.Add thisEquipment, equipmentCollection
Set equipmentCollection = New Collection
End If
Next
'Check input
Dim tmpCollection As Collection
For Each key In equipmentDictionary.Keys
Debug.Print "--------------" & key & "---------------"
Set tmpCollection = equipmentDictionary.Item(key)
For i = 1 To tmpCollection.Count
Debug.Print tmpCollection.Item(i)
Next
Next
Note that this solution assumes that all the equipment are sorted!
Arrays in VBA are more or less like everywhere else with various peculiarities:
Redimensioning an array is possible (although not required).
Most of the array properties (e.g., Sheets array in a Workbook) are 1-based. Although, as rightly pointed out by #TimWilliams, the user-defined arrays are actually 0-based. The array below defines a string array with a length of 11 (10 indicates the upper position).
Other than that and the peculiarities regarding notations, you shouldn't find any problem to deal with VBA arrays.
Dim stringArray(10) As String
stringArray(1) = "first val"
stringArray(2) = "second val"
'etc.
Regarding what you are requesting, you can create a dictionary in VBA and include a list on it (or the VBA equivalent: Collection), here you have a sample code:
Set dict = CreateObject("Scripting.Dictionary")
Set coll = New Collection
coll.Add ("coll1")
coll.Add ("coll2")
coll.Add ("coll3")
If Not dict.Exists("dict1") Then
dict.Add "dict1", coll
End If
Dim curVal As String: curVal = dict("dict1")(3) '-> "coll3"
Set dict = Nothing
You can have dictionaries within dictionaries. No need to use arrays or collections unless you have a specific need to.
Sub FillNestedDictionairies()
Dim dcParent As Scripting.Dictionary
Dim dcChild As Scripting.Dictionary
Dim rCell As Range
Dim vaSplit As Variant
Dim vParentKey As Variant, vChildKey As Variant
Set dcParent = New Scripting.Dictionary
'Don't use currentregion if you have adjacent data
For Each rCell In Sheet2.Range("A1").CurrentRegion.Cells
'assume the text is separated by a space
vaSplit = Split(rCell.Value, Space(1))
'If it's already there, set the child to what's there
If dcParent.Exists(vaSplit(0)) Then
Set dcChild = dcParent.Item(vaSplit(0))
Else 'create a new child
Set dcChild = New Scripting.Dictionary
dcParent.Add vaSplit(0), dcChild
End If
'Assumes unique post-space data - text for Exists if that's not the case
dcChild.Add CStr(vaSplit(1)), vaSplit(1)
Next rCell
'Output to prove it works
For Each vParentKey In dcParent.Keys
For Each vChildKey In dcParent.Item(vParentKey).Keys
Debug.Print vParentKey, vChildKey
Next vChildKey
Next vParentKey
End Sub
I am not that familiar with C++ and Python (been a long time) so I can't really speak to the differences with VBA, but I can say that working with Arrays in VBA is not especially complicated.
In my own humble opinion, the best way to work with dynamic arrays in VBA is to Dimension it to a large number, and shrink it when you are done adding elements to it. Indeed, Redim Preserve, where you redimension the array while saving the values, has a HUGE performance cost. You should NEVER use Redim Preserve inside a loop, the execution would be painfully slow
Adapt the following piece of code, given as an example:
Sub CreateArrays()
Dim wS As Worksheet
Set wS = ActiveSheet
Dim Flanged_connections()
ReDim Flanged_connections(WorksheetFunction.CountIf(wS.Columns(1), _
"Flanged_connections"))
For i = 1 To wS.Cells(1, 1).CurrentRegion.Rows.Count Step 1
If UCase(wS.Cells(i, 1).Value) = "FLANGED_CONNECTIONS" Then ' UCASE = Capitalize everything
Flanged_connections(c1) = wS.Cells(i, 2).Value
End If
Next i
End Sub
I have the following Data in Excel.
CHM0123456 SRM0123:01
CHM0123456 SRM0123:02
CHM0123456 SRM0256:12
CHM0123456 SRM0123:03
CHM0123457 SRM0789:01
CHM0123457 SRM0789:02
CHM0123457 SRM0789:03
CHM0123457 SRM0789:04
What I need to do is pull out all the relevent SRM numbers that relate to a single CHM ref. now I have a formular that will do some thing like this
=INDEX($C$2:$C$6, SMALL(IF($B$8=$B$2:$B$6, ROW($B$2:$B$6)-MIN(ROW($B$2:$B$6))+1, ""), ROW(A1)))
however this is a bit untidy and I really want to produce this same using short vb script, do i jsut have to right a loop that will run though and check each row in turn.
For x = 1 to 6555
if Ax = Chm123456
string = string + Bx
else
next
which should give me a final string of
SRM0123:01,SRM123:02,SRM0256:12,SRM0123:03
to use with how i want.
Or is ther a neater way to do this ?
Cheers
Aaron
my current code
For x = 2 To 6555
If Cells(x, 1).Value = "CHM0123456" Then
outstring = outstring + vbCr + Cells(x, 2).Value
End If
Next
MsgBox (outstring)
End Function
I'm not sure what your definition of 'neat' is, but here is a VBA function that I consider very neat and also flexible and it's lightning fast (10k+ entires with no lag). You pass it the CHM you want to look for, then the range to look in. You can pass a third optional paramater to set how each entry is seperated. So in your case you could write (assuming your list is :
=ListUnique(B2, B2:B6555)
You can also use Char(10) as the third parameter to seperat by line breaks, etc.
Function ListUnique(ByVal search_text As String, _
ByVal cell_range As range, _
Optional seperator As String = ", ") As String
Application.ScreenUpdating = False
Dim result As String
Dim i as Long
Dim cell As range
Dim keys As Variant
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
On Error Resume Next
For Each cell In cell_range
If cell.Value = search_text Then
dict.Add cell.Offset(, 1).Value, 1
End If
Next
keys = dict.keys
For i = 0 To UBound(keys)
result = result & (seperator & keys(i))
Next
If Len(result) <> 0 Then
result = Right$(result, (Len(result) - Len(seperator)))
End If
ListUnique = result
Application.ScreenUpdating = True
End Function
How it works: It simple loops through your range looking for the search_string you give it. If it finds it, it adds it to a dictionary object (which will eliminate all dupes). You dump the results in an array then create a string out of them. Technically you can just pass it "B:B" as the search array if you aren't sure where the end of the column is and this function will still work just fine (1/5th of a second for scanning every cell in column B with 1000 unique hits returned).
Another solution would be to do an advancedfilter for Chm123456 and then you could copy those to another range. If you get them in a string array you can use the built-in excel function Join(saString, ",") (only works with string arrays).
Not actual code for you but it points you in a possible direction that can be helpful.
OK, this might be pretty fast for a ton of data. Grabbing the data for each cell takes a ton of time, it is better to grab it all at once. The the unique to paste and then grab the data using
vData=rUnique
where vData is a variant and rUnique is the is the copied cells. This might actually be faster than grabbing each data point point by point (excel internally can copy and paste extremely fast). Another option would be to grab the unique data without having the copy and past happen, here's how:
dim i as long
dim runique as range, reach as range
dim sData as string
dim vdata as variant
set runique=advancedfilter(...) 'Filter in place
set runique=runique.specialcells(xlCellTypeVisible)
for each reach in runique.areas
vdata=reach
for i=lbound(vdata) to ubound(vdata)
sdata=sdata & vdata(i,1)
next l
next reach
Personally, I would prefer the internal copy paste then you could go through each sheet and then grab the data at the very end (this would be pretty fast, faster than looping through each cell). So going through each sheet.
dim wks as worksheet
for each wks in Activeworkbook.Worksheets
if wks.name <> "CopiedToWorksheet" then
advancedfilter(...) 'Copy to bottom of list, so you'll need code for that
end if
next wks
vdata=activeworkbook.sheets("CopiedToWorksheet").usedrange
sData=vdata(1,1)
for i=lbound(vdata) + 1 to ubound(vdata)
sData=sData & ","
next i
The above code should be blazing fast. I don't think you can use Join on a variant, but you could always attempt it, that would make it even faster. You could also try application.worksheetfunctions.contat (or whatever the contatenate function is) to combine the results and then just grab the final result.
On Error Resume Next
wks.ShowAllData
On Error GoTo 0
wks.UsedRange.Rows.Hidden = False
wks.UsedRange.Columns.Hidden = False
rFilterLocation.ClearContents