Anyone have any idea why i am getting a subscript out of range error at the IF statement. I am just learning arrays so i can only assume it has to do with that.
Dim CARMA2 As Worksheet
Dim Assignments As Worksheet
Sub data2()
Dim arr() As Variant
Dim CAR() As Variant
arr = Array(Worksheets("Assignments").UsedRange)
CAR = Array(Worksheets("CARMA2").UsedRange)
Dim i As Variant
For x = LBound(CAR, 1) To UBound(CAR, 1)
For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i, 5) = CAR(x, 1) And arr(i, 7) = """" Then
arr(i, 7) = CAR(x, 3)
End If
Next i
Next x
End Sub
To put all the values from a range into a 2-d array, assign the Value property of the range to a Variant, like
Dim arr As Variant
arr = Worksheets("Assignments").UsedRange.Value
You can use Dim arr() as Variant, but it's unnecessary. It's just coercing every element of the array to a Variant. But Dim arr As Variant will create a variant array (not an array of variants) and the elements will be typed as appropriate.
When you create this kind of array, it's base 1 array. So your 3, 5, and 7 need to account for that.
Sub data2()
Dim arr As Variant
Dim CAR As Variant
Dim x As Long, i As Long
arr = Worksheets("Assignments").UsedRange.Value
CAR = Worksheets("CARMA2").UsedRange.Value
For x = LBound(CAR, 1) To UBound(CAR, 1)
For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i, 5) = CAR(x, 1) And arr(i, 7) = """" Then
arr(i, 7) = CAR(x, 3)
End If
Next i
Next x
End Sub
Related
I'm trying to call a function to process some data in an array, I will be duplicating this for lots of different reasons, so just want to get the basic foundations right and I'm getting errors with data types. I've simplified my code to try and get it going from the ground up but still can't find the cause.
Sub VBA_Split_Print()
Dim last_row As Long
last_row = Cells(Rows.Count, 1).End(xlUp).Row
Range("J2:AE90000").ClearContents
For J = 2 To last_row
Dim arr() As String
arr = Split(Worksheets("Raw").Cells(J, 9).Value, ",")
Call ElectiveAdd(arr)
Next J
End Sub
Function ElectiveAdd(ByRef arr() As String)
Dim arrLength As Integer
arrLength = UBound(arr, 1) - LBound(arr, 1)
Dim x As Integer
x = 0
For i = 24 To (arrLength + 24)
Worksheets("Raw").Cells(J, i).Value = arr(x)
x = x + 1
Next i
End Function
When I'm trying to run this I am getting an Run-Time Error '1004' Application-Defined or Object-Defined Error message.
So revised code due to feedback and I feel that J is another issue so I have excluded it, thanks for pointing out the error though!
Sub VBA_Split_Print()
Dim last_row As Long
last_row = Cells(Rows.Count, 1).End(xlUp).row
Range("J2:AE90000").ClearContents
Dim arr() As String
arr = Split(Worksheets("Raw").Cells(2, 9).Value, ",")
Call ElectiveAdd(arr)
End Sub
Function ElectiveAdd(ByRef arr() As String)
Dim arrLength As Integer
arrLength = UBound(arr, 1) - LBound(arr, 1)
Dim x As Integer
x = 0
For i = 24 To (arrLength + 24) + 1
Worksheets("Raw").Cells(2, i).Value = arr(x)
x = x + 1
Next i
End Function
Now I am getting a different error message of subscript out of range, cell 2,9 = "
Instead of passing the array, why not pass the cell?
Option Explicit
Sub VBA_Split_Print()
Dim last_row As Long
Dim I As Long
Dim arr() As String
With Worksheets("Raw")
last_row = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("J2:AE90000").ClearContents
For I = 2 To last_row
Call ElectiveAdd(Worksheets("Raw").Cells(I, 9))
Next I
End With
End Sub
Function ElectiveAdd(ByRef rng As Range)
Dim arr As Variant
Dim I As Long
arr = Split(rng.Value, ",")
For I = LBound(arr, 1) To UBound(arr, 1)
rng.Parent.Cells(rng.Row, 24 + I).Value = arr(I)
Next I
End Function
If you still want to pass the array you'll probably need to pass the row as well so the data goes in the right place.
Option Explicit
Sub VBA_Split_Print()
Dim last_row As Long
Dim I As Long
Dim arr() As String
With Worksheets("Raw")
last_row = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("J2:AE90000").ClearContents
For I = 2 To last_row
arr = Split(Worksheets("Raw").Cells(I, 9), ",")
Call ElectiveAdd(arr, I)
Next I
End With
End Sub
Function ElectiveAdd(ByRef arr As Variant, rw As Long)
Dim I As Long
For I = LBound(arr, 1) To UBound(arr, 1)
Worksheets("Raw").Cells(rw, 24 + I).Value = arr(I)
Next I
End Function
I am populating a array with values from part of a column (range). The resulting array is multidimensional - but it should be one dimensional. I want to get just Emp ID values into the array:
I have tried this :
Sub Test()
Dim colPostionNumber As Integer
Dim lastRow As Integer
Dim ws As Worksheet
Dim positionNumberArray As Variant
Set ws = ActiveSheet
With ActiveWorkbook.Sheets("Sheet 1")
colPositionNumber = Application.WorksheetFunction.Match("Emp ID", ws.Rows(5), 0)
lastRow = ws.UsedRange.SpecialCells(xlCellTypeLastCell).row
positionNumberArray = .Range(Cells(5, colPositionNumber), Cells(lastRow, colPositionNumber)).Value
End With
End Sub
But the resulting array is two dimensional
I tried reDim but that didn't work. How do I do this with a one dimensional array?
Write One-Column 2D Array to 1D Array
To get a zero-based 1D array, you will have to loop.
Sub Test()
Dim colPositionNumber As Long
Dim lastRow As Long
Dim ws As Worksheet
Dim Data As Variant
Dim positionNumberArray As Variant
Set ws = ActiveSheet
With ActiveWorkbook.Sheets("Sheet 1")
colPositionNumber = Application.Match("Emp ID", ws.Rows(5), 0)
lastRow = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Data = .Range(.Cells(5, colPositionNumber), _
.Cells(lastRow, colPositionNumber)).Value
ReDim positionNumberArray(UBound(Data, 1) - 1)
Dim n As Long
For n = 1 To UBound(Data, 1)
positionNumberArray(n - 1) = Data(n, 1)
Next n
End With
End Sub
Using Application.Transpose
The following procedures show how to write a one-column or a one-row range to a one-based 1D array:
Sub testATColumn()
Dim rg As Range: Set rg = Range("A1:A5")
Dim arr As Variant: arr = Application.Transpose(rg.Value)
Debug.Print LBound(arr, 1), UBound(arr, 1)
On Error Resume Next
Debug.Print LBound(arr, 2), UBound(arr, 2)
On Error GoTo 0
End Sub
Sub testATRow()
Dim rg As Range: Set rg = Range("A1:E1")
Dim arr As Variant
arr = Application.Transpose(Application.Transpose(rg.Value))
Debug.Print LBound(arr, 1), UBound(arr, 1)
On Error Resume Next
Debug.Print LBound(arr, 2), UBound(arr, 2)
On Error GoTo 0
End Sub
Note that Application.Transpose has a limit of 65535 elements per dimension.
Reduce dimension via Excel function ArrayToText()
If you dispose of version MS 365 you could try the following approach via Excel function ArrayToText() and an eventual split action.
Sub reduceDim()
Dim t#: t = Timer
Dim rng As Range
Set rng = Sheet1.Range("B2:B7") ' << change to your needs
Dim data
data = Split(Evaluate("ArrayToText(" & rng.Address(False, False, External:=True) & ")"), ", ")
Debug.Print "Array(" & LBound(data) & " To " & UBound(data) & ")"
Debug.Print Join(data, "|") ' display resulting 0-based 1-dim array elements
Debug.Print Format(Timer - t, "0.00 secs")
End Sub
Output in VB Editor's immediate window
Array(0 To 5)
1|2|3|4|5|6
0,00 secs
I need to compare two ranges and see if value in one range appears in the other. This is the code I use:
Dim rng1 As Range
Dim rng2 As Range
Dim cell as Range
Dim found as Range
set rng1 = ....
set rng2 = ....
for each cell in rng1
set found = rng2.Find(what:=cell,.....
Next cell
This code is OK if the range is in thousands of rows, single column. When it comes to tens of thousands, it's very slow.
Anyway to speed it up?
This might be the fastest way for large amounts of data:
Option Explicit
Sub Test()
Dim rng1 As Range
Set rng1 = YourShorterRange
Dim rng2 As Range
Set rng2 = YourLargerRange
Dim C As Range
Dim Matches As Object: Set Matches = CreateObject("Scripting.Dictionary")
'input the larger data inside a dictionary
For Each C In rng2
If Not Matches.Exists(C.Value) Then Matches.Add C.Value, 1
Next C
Dim i As Long
Dim arr As Variant
'input the shorter data inside an array
arr = rng1.Value
For i = 1 To UBound(arr)
If Matches.Exists(arr(i, 1)) Then
'your code if the value is found
End If
Next i
End Sub
Edit for Dorian:
Option Explicit
Sub Test()
Dim rng1 As Range
Set rng1 = YourShorterRange
Dim rng2 As Range
Set rng2 = YourLargerRange
Dim i As Long, j As Long
Dim arr As Variant
Dim Matches As Object: Set Matches = CreateObject("Scripting.Dictionary")
arr = rng1.Value
'input the larger data inside a dictionary
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
If Not Matches.Exists(arr(i, j)) Then Matches.Add arr(i, j), 1
Next j
Next i
'input the shorter data inside an array
arr = rng2.Value
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
If Matches.Exists(arr(i, j)) Then
'your code if the value is found
End If
Next j
Next i
End Sub
Maybe something along these lines:
Sub Test()
Dim arr1 As Variant, arr2 As Variant
Dim arrList As Object: Set arrList = CreateObject("System.Collections.ArrayList")
Dim x As Long
arr1 = rng1 'Specify your range
arr2 = rng2 'Specify your range
For x = LBound(arr2) To UBound(arr2)
arrList.Add arr2(x, 1)
Next x
For x = LBound(arr1) To UBound(arr1)
If arrList.contains(arr1(x, 1)) = True Then
Debug.Print arr1(x, 1) & " contained within range 2"
End If
Next x
End Sub
I would suggest you :
Application.match
You can also look here you will find an interesting studies on 3 different ways of Search. Those 3 Different way will be studied By Time and By number of occurences.
According Fastexcel the conclusion of this study is :
Don’t use Range.Find unless you want to search a large number of
columns for the same thing (you would have to do a Match for each
column).
The Variant array approach is surprisingly effective,
particularly when you expect a large number of hits.
Match wins easily
for a small number of hits.
So If you except a large number of hit you might have to give a try variant array method. The 3 ways are listed in Fastexcel tuto
Edit
After reading some comment I did a new test :
Variant code
Sub Test1()
Dim vArr As Variant
Dim j As Long
Dim n As Long
Dim dTime As Double
dTime = MicroTimer
vArr = Range("A1:B100000").Value2
Dim Matches As Object: Set Matches = CreateObject("Scripting.Dictionary")
arr = Range("G1:G15").Value
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
If Not Matches.Exists(arr(i, j)) Then Matches.Add arr(i, j), 1
Next j
Next i
For j = LBound(vArr) To UBound(vArr)
If Matches.Exists(vArr(j, 1)) Or Matches.Exists(vArr(j, 2)) Then n = n + 1
Next j
Debug.Print "Using Variant : " & n & " Timer :" & (MicroTimer - dTime) * 1000
End Sub
Dictionary
Sub Test()
Dim rng1 As Range
Set rng1 = Range("A1:B100000")
Dim rng2 As Range
Set rng2 = Range("G1:G15")
Dim i As Long, j As Long
Dim arr As Variant
Dim dTime As Double
dTime = MicroTimer
Dim Matches As Object: Set Matches = CreateObject("Scripting.Dictionary")
arr = rng2.Value
'input the larger data inside a dictionary
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
If Not Matches.Exists(arr(i, j)) Then Matches.Add arr(i, j), 1
Next j
Next i
'input the shorter data inside an array
arr = rng1.Value
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
If Matches.Exists(arr(i, j)) Then
'your code if the value is found
cpt = cpt + 1
End If
Next j
Next i
Debug.Print "Using Damian Method : " & cpt & " Timer : " & (MicroTimer - dTime) * 1000
End Sub
I am trying to iterate through an array using:-
For i = LBound(arr, 1) To UBound(arr, 1)
Debug.Print arr(i, 1)
Next i
but receive a Subscript out of range error at Debug.Print arr(i, 1) which I do not understand. The code works fine if I take out the above lines.
Sub Summarise()
Dim dict
Dim i As Long
Dim arr() As Variant
Dim n As Long
Dim ws As Worksheet
Dim ws2 As Worksheet
Set ws2 = Worksheets("Plan")
Set ws = Worksheets("Data")
dict = ws.[A1].CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(dict, 1)
.Item(dict(i, 1)) = .Item(dict(i, 1)) + dict(i, 5)
Next
arr = Array(.Keys, .items)
n = .Count
End With
For i = LBound(arr, 1) To UBound(arr, 1)
Debug.Print arr(i, 1)
Next i
ws2.[A1].CurrentRegion.ClearContents
ws2.[A1].Resize(n, 2).Value = Application.Transpose(arr)
End Sub
Your line arr = Array(.Keys, .items) is creating an array of arrays and not an array of those items.
i.e. Array(Array(1,2,3), Array(4,5,6))
To loop through this you would need to do something like
For i = LBound(arr, 1) To UBound(arr, 1)
For j = LBound(arr(i)) to UBound(arr(i))
Debug.Print arr(i)(j)
Next j
Next i
To avoid doing this and loop through as you're currently you could add to your array as you add to your dictionary
I'm trying to learn how to use a dictionary in Excel VBA. The test is to get all values from rows 1-100000 in column A to a dictionary via an array and then write all the values to column B. This works fine until row 34464, the rest of the rows in column B just gets #N/A.
Any ideas why?
Sub nnn()
'Tools - References - Microsoft Scripting Runtime
Dim myArray As Variant
Dim myRow As Long
Dim dicMyDictionary As Scripting.Dictionary
Set dicMyDictionary = New Scripting.Dictionary
With ThisWorkbook.Worksheets("Sheet1")
myArray = Range(Cells(1, 1), Cells(100000, 1)).Value
For myRow = LBound(myArray, 1) To UBound(myArray, 1)
dicMyDictionary.Add myRow, myArray(myRow, 1)
Next myRow
myArray = dicMyDictionary.Items
.Range("B1").Resize(dicMyDictionary.Count, 1).Value = Application.Transpose(myArray)
Set dicMyDictionary = Nothing
End With
End Sub
Because of the limitations of the worksheetfunction Transpose (see also the links posted by Paul Bica), you need to assign the elements to the array directly. The following should work:
Option Explicit
Sub nnn()
'Tools - References - Microsoft Scripting Runtime
Dim myArray As Variant
Dim myRow As Long
Dim dicMyDictionary As Scripting.Dictionary
Set dicMyDictionary = New Scripting.Dictionary
With ThisWorkbook.Worksheets("Sheet1")
myArray = Range(Cells(1, 1), Cells(100000, 1)).Value
For myRow = LBound(myArray, 1) To UBound(myArray, 1)
dicMyDictionary.Add myRow, myArray(myRow, 1)
Next myRow
ReDim myArray(1 To dicMyDictionary.Count, 1 To 1)
For myRow = 1 To UBound(myArray, 1)
myArray(myRow, 1) = dicMyDictionary(myRow)
Next myRow
.Range("B1").Resize(dicMyDictionary.Count, 1).Value = myArray
Set dicMyDictionary = Nothing
End With
End Sub