I thought this would be simple, but apparently the geniuses at Microsoft think differently.
I am writing Excel VBA to loop through the rows in an Excel worksheet and for each row (a Range object), I want to extract the cell values as an array. I've done some searching and found some supposed solutions that are not at all intuitive, nor do they work.
Does anyone have suggestions on how to do this?
Private Sub Separate_By_DC()
Dim row_ As Range
Dim row_str As String
For Each row_ In ActiveSheet.UsedRange.Rows
Dim arr As Variant
arr = Row_To_Array(row_)
Debug.Print UBound(arr) - LBound(arr) + 1
' row_str = Concat_Row(row_)
' Debug.Print row_str
Next row_
End Sub
Private Function Row_To_Array(row_ As Range) As Variant
Row_To_Array = row_.Value
End Function
Think the most easiest way would be:
Sub test()
Dim mArr As Variant
Dim i As Long
mArr = Application.Transpose(Range("A1:A10")) 'Transpoose to make the array one dimensional
'loop through the array
For i = LBound(mArr, 1) To UBound(mArr, 1) 'For one dimensional you can remove ",1"
'do something with mArr value
Cells(i, "C").Value = mArr(i) 'Print the array value
Next i
End Sub
For 2 dimensional array you can loop through it by state the dimensional index:
Dim mArr As Variant
Dim i As Long
mArr = Range("A1:A10") 'Use 2 dimension
'loop through the array
For i = LBound(mArr, 1) To UBound(mArr, 1)
'do something with mArr value
Cells(i, "C").Value = mArr(i, 1)
Next i
Related
I have a column that has text in some cells and formulas in the others. When I'm trying to loop through an array to search for some values in the columns, I can't seem to reference the values as a result of formulas. For example, I'm trying to do conditional statements like If arr(i, 15) = "String" Then but String is the result of a Vlookup.
printing the entire array gives me the formulas, not the results
Sub test()
Dim ws As Worksheet
Dim arr As Variant
Set ws = ThisWorkbook.Worksheets("Sheet1")
arr = ws.Range("A1").CurrentRegion.Formula
For i = LBound(arr, 1) To UBound(arr, 1)
If Not IsError(arr(i, 15)) Then 'Some of the values are #NA
Debug.Print arr(i, 15)
End If
Next i
End Sub
If you only want to obtain value from cells formula not result in error, probably array may not suitable in such case, use For loop will achieve your expected input also. In my example, Range("E3) is not printed due to error, you can combine with lastrow for dynamic range:
I add version 2 here for using array looping, the outcome skip to print Range("E2") due to error, hope it help :)
Sub test()
Dim ws As Worksheet
Dim arr As Variant
Dim i As Long
Dim textValue As String
Set ws = ThisWorkbook.Worksheets("Sheet2")
arr = ws.Range("D1").CurrentRegion.Value
For i = LBound(arr) To UBound(arr)
textValue = CStr(arr(i, 2))
If InStr(textValue, "Error") <= 0 Then 'Some of the values are #NA
Debug.Print textValue
End If
Next i
End Sub
your code has an End If without if
To get the value of the formula, use Evaluate(formula), this line only work if send a formula as parameter, use on error resume next if is possible to sent errors, empty values or not formula values... Good Luck
Sub test()
Dim ws As Worksheet
Dim arr As Variant
Set ws = ThisWorkbook.Worksheets("Sheet1")
arr = ws.Range("A1").CurrentRegion.Formula
For i = LBound(arr, 1) To UBound(arr, 1)
On Error Resume Next
If Not IsError(arr(i, 15)) Then 'Some of the values are #
Debug.Print Evaluate(arr(i, 15))
'End If
End If
Next I
End Sub
Recently I was wondering about the possibility of speeding up the program by switching a part of the code below:
Dim cell as Variant
Dim myValues() as Double
ReDim myValues(myRange.Count - 1)
Dim i as Integer: i = 0
For Each cell in myRange.Cells
myValue(i) = cell.Value
i = i + 1
Next cell
into a loop where I could refer to the value of each cell directly, instead of instantiating a cell object, assigning it a cell value from a given range, and then extracting the cell value.
In my mind, the pseudocode would look something like this:
Dim cellValue as Double
Dim myValues() as Double
ReDim myValues(myRange.Count - 1)
Dim i as Integer: i = 0
For each cellValue in myRange.Cells.Values
myValues(i) = cellValue
i = i + 1
Next cellValue
If my overall concept is wrong from the start, or if you can't get the cells values from Range faster, then there was no question.
Due to the fact that this is my first post, I could have written something incorrectly / in wrong posting convention. Let me know and I'll fix it.
Cheers
As #SJR notes, this is a common way to access data from a range without going cell-by-cell
Dim arr, i as long, rng As Range
Set rng = Activesheet.Range("A1:B20")
arr = rng.Value 'arr is now a 2D array (1 To 20, 1 To 2)
'Note: base is 1 and not the more-typical 0
For i = 1 to ubound(arr,1)
Debug.Print arr(i, 1), arr(i, 2)
Next i
arr(3, 2) = 999
rng.value = arr 'put the data back to the range
If the reason is for getting rid of the 2D array a function like this can be the solution:
Function VectorFromRange(rng As Range) As Variant
Dim arrIn As Variant
arr = rng.value 'Dumping the data from range
Dim i As Long
Dim item As Variant
ReDim arrOut(1 To rng.Cells.Count) As Variant
For Each item In arr
i = i + 1
arrOut(i) = item
Next item
VectorFromRange = arrOut
End Function
I have a requirement like I have some values in column A and I have multiple values in column B,C,D. If my column contains value X then I want to column header and column A value to be concatenate.
For example
I have gone through lots of question on Stack Overflow and I didn't found anything helpful.
Thanks for your help!
please try this code.
Sub FindValues(ByVal WhereToFind As Range, ByVal WhereToPaste As Range)
'where to find should have the header and values
Dim col As Integer 'loop through columns
Dim row As Integer 'loop through rows
Dim a() As Variant
Dim b() As Variant
Dim i As Integer
a() = WhereToFind
For row = 2 To UBound(a, 1)
For col = 2 To UBound(a, 2)
If a(row, col) = "x" Then
i = i + 1
ReDim Preserve b(1 To i)
b(i) = a(1, col) & "=" & a(row, 1)
End If
Next
Next
WhereToPaste.Resize(UBound(b)).Value = Application.Transpose(b())
End Sub
that should be called like
Sub caller()
FindValues ThisWorkbook.Sheets("Sheet1").Range("A1:E4"), ThisWorkbook.Sheets("Sheet1").Range("F1")
End Sub
the output is like
So I am trying to create a combined list from two separate columns by omitting the duplicate items. I have searched and found a formula that combines the list this way by going through one column at a time.
But I want to combine the columns like this:
where it goes through each row first.
Is there a formula or VBA code that does that? Thank you.
EDIT: This is just a way to show my request. The color was added to show how the combined list is sorted, it is not part of the request. The actual lists are each about 500 rows long consisting of 9+ digit ID numbers.
This will put the unique words in the order you want.
Sub foo()
Dim rng As Range
Dim ws As Worksheet
Dim i&, j&, t&
Dim dict As Object
Dim iArr() As Variant
Dim oarr() As Variant
Dim itm As Variant
Set dict = CreateObject("Scripting.Dictionary")
Set ws = ActiveSheet
With ws
Set rng = .Range("A:B").Find("*", .Range("A1"), , , , xlPrevious)
If Not rng Is Nothing Then
iArr = .Range(.Cells(2, 1), .Cells(rng.Row, 2)).Value
For i = LBound(iArr, 1) To UBound(iArr, 1)
For j = LBound(iArr, 2) To UBound(iArr, 2)
If iArr(i, j) <> "" Then
On Error Resume Next
dict.Add iArr(i, j), iArr(i, j)
On Error GoTo 0
End If
Next j
Next i
End If
'If your dataset is not that large <30,000, then you can use it directly with transpose
.Range("C2").Resize(dict.Count) = Application.Transpose(dict.items)
'If your data is large then you will want to put it in a one dimensional array first
'just uncomment the below and comment the one line above
' ReDim oarr(1 To dict.Count, 1 To 1)
' t = 1
' For Each itm In dict.keys
' oarr(t, 1) = dict(itm)
' t = t + 1
' Next itm
' Range("C2").Resize(dict.Count) = oarr
End With
End Sub
UDF solution. Using your provided sample data, put this formula in cell I2 and copy down =UnqList(ROW(I1),$G$2:$H$6) or =UnqList(ROW(I1),$G$2:$G$6,$H$2:$H$6) (it can be either because the two or more lists might not be next to each other and the UDF accounts for that)
Public Function UnqList(ByVal lIndex As Long, ParamArray rLists() As Variant) As Variant
Dim i As Long, j As Long
Dim vList As Variant
Dim cUnq As Collection
Dim lMaxRow As Long, lMaxCol As Long
If lIndex <= 0 Then
UnqList = CVErr(xlErrRef)
Exit Function
End If
For Each vList In rLists
If TypeName(vList) <> "Range" Then
UnqList = CVErr(xlErrRef)
Exit Function
Else
If vList.Rows.Count > lMaxRow Then lMaxRow = vList.Rows.Count
If vList.Columns.Count > lMaxCol Then lMaxCol = vList.Columns.Count
End If
Next vList
Set cUnq = New Collection
For i = 1 To lMaxRow
For j = 1 To lMaxCol
For Each vList In rLists
If i <= vList.Rows.Count And j <= vList.Columns.Count Then
On Error Resume Next
cUnq.Add vList.Cells(i, j).Value, CStr(vList.Cells(i, j).Value)
On Error GoTo 0
If lIndex = cUnq.Count Then
UnqList = cUnq(cUnq.Count)
Set cUnq = Nothing
Exit Function
End If
End If
Next vList
Next j
Next i
UnqList = CVErr(xlErrRef)
Set cUnq = Nothing
End Function
You can use my Duplicate Master addin available via my profile.
Advantages are that the addin provides options to
ignore capitilisation
ignore whitespace
run RegExp replacements (advanced)
further options for deletinf, highlighting, selecting duplicates etc
I have the following code, which populates my array nicely. The problem is that some of the values are duplicates and I only want unique data. I have seen examples for single-dimensional arrays, but nothing for a multi-dimensional array.
For my use here, the "A" column is an identifier and the "B" column is a name. For example, "A2" may be "A1234" and "B2" would be "Air Rifle". The code in the "A" column will always be unique to the description in the "B" column, so I only need to search duplicates in the "A" column; though, I would be curious about examples that worked each way.
Thanks in advance for any assistance.
Sub testme()
Dim myArray As Variant
myArray = Range("A2:B20")
End Sub
Please check the comments from Ioannis and Alex P first.
This would work using a dictionary object:
Sub UniqueValuesOnly()
Dim myArray As Variant, a As Integer
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
myArray = Range("A2:B20")
For a = 1 To UBound(myArray, 1)
If Not dict.Exists(myArray(a, 1)) Then
dict.Add myArray(a, 1), myArray(a, 2)
End If
Next a
For Each Key In dict
Debug.Print Key, dict(Key) //Let's print out the content to see if it worked...
Next Key
Set dict = Nothing
End Sub
I took the link from Alex P's comment from my question and tweaked to work. I prefer the elegance of the dictionary entry, so I marked that as the answer, but I wanted to share the tweak in case it helps someone else.
Sub Test()
Dim firstRow As Integer, lastRow As Integer, cnt As Integer, iCell As Integer
Dim myArray()
ReDim myArray(1, 0)
' Debug.Print UBound(myArray)
cnt = 0
firstRow = 2
lastRow = 20
For iCell = firstRow To lastRow
If Not IsInArray(myArray, Cells(iCell, 2)) Then
ReDim Preserve myArray(0 To 1, 0 To cnt)
myArray(0, cnt) = Cells(iCell, 1)
myArray(1, cnt) = Cells(iCell, 2)
cnt = cnt + 1
End If
Next iCell
End Sub
Function IsInArray(myArray As Variant, val As String) As Boolean
Dim i As Integer, found As Boolean
found = False
If Not Len(myArray(0, 0)) > 0 Then
found = False
Else
For i = 0 To UBound(myArray, 2)
If myArray(0, i) = val Then
found = True
Exit For
End If
Next i
End If
IsInArray = found
End Function
Edited to include #PatrickLepelletier's suggestion and exit the loop after "found = true".