when running below code I get "Object Required" error on the last line in the code. I cant really figure out why.
Dim FirstCurrentRange As Range
Dim FirstRowCounter As Long
Dim FirstArrayCounter As Variant
Dim FirstCurrentArray() As Variant
Dim ColumnCounter As Long
Dim ArrayCounter As Variant
Dim CurrentArray() As Variant
Dim SiteNameMatch As Long
Set FirstCurrentRange = ThisWorkbook.Worksheets(InputSheet.Name).ListObjects("DataTable").Range
FirstArrayCounter = 0
For FirstRowCounter = 2 To FirstCurrentRange.Rows.Count
FirstArrayCounter = FirstArrayCounter + 1
ReDim Preserve FirstCurrentArray(1, FirstArrayCounter)
FirstCurrentArray(1, FirstArrayCounter) = FirstCurrentRange(FirstRowCounter, 4).Value
Next FirstRowCounter
ThisWorkbook.Worksheets(DeleteMe.Name).Range("A1:A" & FirstArrayCounter).Value = Application.WorksheetFunction.Transpose(FirstCurrentArray)
ReDim Preserve CurrentArray(2, FirstArrayCounter)
ArrayCounter = 0
For ColumnCounter = LBound(FirstCurrentArray, 2) To UBound(FirstCurrentArray, 2)
SiteNameMatch = Application.WorksheetFunction.Match(FirstCurrentArray(1, ColumnCounter).Value, ThisWorkbook.Worksheets(ContactListSheet.Name).ListObjects("ContactTable").ListColumns("Site").DataBodyRange, 0)
why simple arrayCounters are variants instead longs?
Related
I get the 'Object Required' error when trying to parse a value from a list into an array. The weird thing is, is that I do it once and it works, but when I try and parse the second value with a different offset it gives me the 'Object Required' error.
Sub Run_Click()
Dim ArrVal() As Variant
Dim DateRange As Range
Dim ComValue() As Variant
Dim LastRow As Long
Dim i As Long
Dim numRow As Variant
Dim sh2 As Worksheet
Dim ConvertVal As String
Dim check As Variant
Dim DutyTest() As Variant
Set sh2 = Sheets(2)
With Sheets("Sheet1")
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row - 7
ReDim Preserve ComValue(1 To LastRow)
ReDim Preserve ArrVal(1 To LastRow)
ReDim Preserve DutyTest(1 To LastRow)
Set DateRange = .Range("A" & 8 & ":A" & 7 + LastRow)
i = 1
Do While i <= LastRow
If i > LastRow Then GoTo ErrorHandler
For Each RowCount In DateRange
'On Error GoTo ErrorHandler
ComValue(i) = .Range("A" & i + 7).Value
ConvertVal = CStr(ComValue(i))
numRow = Application.Match(ConvertVal, sh2.Range("A1:A990000"), 0)
ArrVal(i) = sh2.Range("A" & numRow).Offset(0, 2).Value
DutyTest(i) = sht2.Range("A" & numRow).Offset(1, 1).Value
If i = LastRow Then
Range("B8").Resize(UBound(ArrVal), 1).Formula = Application.Transpose(ArrVal)
End If
i = i + 1
Next RowCount
Loop
ErrorHandler:
End With
End Sub
The error is pulled on the DutyTest(i) line below the ComValue(i) line which gets returned fine. The only difference I can think of is that ComValue(i) is a percent that is returned, in the offset field for DutyTest(i) it should return a string instead, could that be causing the issue?
You have written sht2 as the sheet reference instead of sh2. This is the object reference error here, I think.
I believe it is good practice in VBA to enforce variable declaration with Option Explicit:
https://riptutorial.com/excel-vba/example/3554/always-use--option-explicit-
https://learn.microsoft.com/en-us/office/vba/Language/Reference/User-Interface-Help/option-explicit-statement
I have lots of recruitment data that i want to re-arrange, separate and modify using arrays. The data includes all information from 1st stage, 2nd stage and 3rd stage interview for each candidates. The idea is to separate each stage onto their own sheets (e.g. Interview 1, interview 2, interview 3). And then to also create a table that has information from all three stages for each candidate.
Firstly, i have created an array of all the data by declaring the range ("A1:AV10000") as a variant.
Then i have created a loop to loop through this data, and separate each type of event that occurs into their own arrays, using an IF function within the loop. If condition is met, create a new array and add each row that condition is met to an array.
However, i believe my arrays are being made into a 3D array and i am sure how to edit the code so that it remains 2Darray. I understand why the code may be creating 3D array (due to iterating by 1 in the loop), however i am unsure how to write code so it includes all data the row and only iterates as shown below.
e.g. currently it goes (1)(1,1),(1)(1,2) then (2)(1,1),(2)(1,2) then (3)(1,1),(3)(1,2).
I would think it would work if it was (1,1)(1,2) then (2,1)(2,2) then (3,1)(3,2). Screenshot of array format from local window
Sub AddProcessStageToArray(SourceWorksheet, RawDataArray, LastrowData, WhatStage, ArrayOutput)
For i = LBound(RawDataArray) To UBound(RawDataArray)
If RawDataArray(i, 13) = WhatStage And RawDataArray(i, 38) <> "NOK" Then
o = o + 1
'Dim ArrayName() As Variant
ReDim Preserve ArrayOutput(o)
ArrayOutput(o) = Application.Index(SourceWorksheet.Range("A1:AO" & LastrowData), i, 0)
End If
Next
End Sub
The code is being called as shown below.
Sub AddITWToArray()
Dim DataWs As Worksheet: Set DataWs = ThisWorkbook.Sheets("DATA")
Dim PoolOfWeekWs As Worksheet: Set PoolOfWeekWs = ThisWorkbook.Sheets("Pool of the week")
Dim LastrowData As Long: LastrowData = DataWs.Range("A" & Rows.Count).End(xlUp).Row
Dim LastColData As Long: LastColData = DataWs.Cells(1 & DataWs.Columns.Count).End(xlToLeft).Column
Dim LastColDataString As String: LastColDataString = Split(Cells(1, LastColData).Address, "$")(1)
Dim DataRange As Range: Set DataRange = DataWs.Range("A1:" & LastColDataString & LastrowData)
Dim DataArr As Variant: DataArr = DataWs.Range("A1:AO" & LastrowData)
'Loop through Data array, if interview process = PQL, add to table. If interview proces = 1sTITW find postion and add data, if 2ndITW find postion and highlight, if 3rd find postion and highlight
Dim PoolofWeekTableLRow As Long: PoolofWeekTableLRow = PoolOfWeekWs.Range("A" & Rows.Count).End(xlUp).Row
'PoolOfWeekWs.Rows("3:" & PoolofWeekTableLRow).ClearContents
Dim i, o As Long
Dim RowNumberArr As Variant
'Create PQLArray
Dim PQLArray() As Variant
Call AddProcessStageToArray(DataWs, DataArr, LastrowData, "Prequalification", PQLArray)
'Create 1ITWArray
Dim FirstITWArray() As Variant
Call AddProcessStageToArray(DataWs, DataArr, LastrowData, "Candidate Interview 1", FirstITWArray)
'Create 2ITWArray
Dim SecondITWArray() As Variant
Call AddProcessStageToArray(DataWs, DataArr, LastrowData, "Candidate Interview 2+", SecondITWArray)
'Create PPLArray
Dim PPLArray() As Variant
Call AddProcessStageToArray(DataWs, DataArr, LastrowData, "Candidate Interview 2*", PPLArray)
Try the next adapted function, please:
Function AddProcessStageToArray(SourceWorksheet As Worksheet, RawDataArray, LastrowData As Long, WhatStage As String) As Variant
Dim ArrayOutput() As Variant, o As Long, i As Long, j As Long
ReDim ArrayOutput(1 To UBound(RawDataArray, 2), 1 To UBound(RawDataArray, 2))
For i = LBound(RawDataArray) To UBound(RawDataArray)
If RawDataArray(i, 13) = WhatStage And RawDataArray(i, 38) <> "NOK" Then
o = o + 1
For j = 1 To UBound(RawDataArray, 2)
ArrayOutput(j, o) = RawDataArray(i, j)
Next j
End If
Next
ReDim Preserve ArrayOutput(1 To UBound(RawDataArray, 2), 1 To o)
AddProcessStageToArray = WorksheetFunction.Transpose(ArrayOutput)
End Function
It can be called in this way:
Sub testAddProcessStToArr()
Dim DataWs As Worksheet, DataArr As Variant, LastrowData As Long
Set DataWs = ThisWorkbook.Sheets("DATA")
LastrowData = DataWs.Range("A" & rows.count).End(xlUp).row
DataArr = DataWs.Range("A1:AO" & LastrowData)
Dim PQLArray() As Variant
PQLArray = AddProcessStageToArray(DataWs, DataArr, LastrowData, "Prequalification")
Dim NewSheet as Worksheet
Set NewSheet = ActiveWorkbook.Sheets.Add
NewSheet.Range("A1").Resize(UBound(PQLArray), UBound(PQLArray, 2)).Value = PQLArray
End Sub
Edited:
Please, also try the next approach, involving a preliminary counting of rows respecting the conditions criteria and then use them to fill the final array. The adapted function to be used will be the next:
Function AddProcessStageToArr(RawDataArray, arrNo As Variant) As Variant
Dim ArrayOutput() As Variant, o As Long, i As Long, j As Long
ReDim ArrayOutput(1 To UBound(arrNo) + 1, 1 To UBound(RawDataArray, 2))
For i = 0 To UBound(arrNo)
o = o + 1
For j = 1 To UBound(RawDataArray, 2)
ArrayOutput(o, j) = RawDataArray(arrNo(i), j)
Next j
Next
AddProcessStageToArr = ArrayOutput
End Function
The above function should be called in the next way:
Sub testAddProcessStToArrBis()
Dim DataWs As Worksheet, DataArr As Variant, LastrowData As Long
Dim arrNo As Variant, i As Long, k As Long
Set DataWs = ActiveSheet
LastrowData = DataWs.Range("A" & rows.count).End(xlUp).row
DataArr = DataWs.Range("A1:AO" & LastrowData).Value
ReDim arrNo(UBound(DataArr))
For i = 1 To UBound(DataArr)
If DataArr(i, 13) = "Prequalification" And DataArr(i, 38) <> "NOK" Then
arrNo(k) = i: k = k + 1
End If
Next i
ReDim Preserve arrNo(k - 1)
Dim PQLArray() As Variant
PQLArray = AddProcessStageToArr(DataArr, arrNo)
Dim NewSheet As Worksheet
Set NewSheet = ActiveWorkbook.Sheets.Add(After:=DataWs)
NewSheet.Range("A1").Resize(UBound(PQLArray), UBound(PQLArray, 2)).Value = PQLArray
End Sub
The same function must be used, but changing "Prequalification" with "Candidate Interview x" and rebuild arrNo for each case...
This is a follow up question to my previous VBA question. Someone provided me with a potential solution for a lag in performance, and mentioned instead of looping through the actual cells in each column, transform the columns into Arrays and then load the results into a new Array.
I keep getting "subscript out of range" issues, among other various errors. I've manipulated these Arrays so many times with ReDim and others to try to load the results, but I keep hitting the same issue. You will see some of the code I tried where things are commented out.
How can I properly load these results based on the information I have? I thought at first it was because I was declaring a dynamic, empty Array, so that's why I used the UBound of an array of the same size in a ReDim.
Sub Missing_CAT():
Dim i As Variant
Dim j As Variant
'Dim j As Long
'Dim h As Long
'Dim h As Variant
Dim d As Date
Dim e As Date
Dim f As Date
Dim a As String
Dim ws As Worksheet
Dim rowCount As Long
Dim secondRowCount As Long
Dim oDateArr() As Variant
Dim fromDateArr() As Variant
Dim toDateArr() As Variant
Dim perilArr() As Variant
Dim resultArr() As Variant
Dim cell As Variant
Dim counter As Variant
Dim count As Long
Dim boundary As Long
Dim ub As Integer
rowCount = Worksheets("raw_data_YOA").Cells(Rows.count, "A").End(xlUp).row
oDateArr = Sheets("raw_data_YOA").Range("Q2:Q" & rowCount).Value
ub = UBound(oDateArr)
ReDim resultArr(ub)
count = 0
'For i = 2 To rowCount
For Each i In oDateArr
'd = Worksheets("raw_data_YOA").Cells(i, 17).Value
d = i
For Each ws In Sheets
If ws.Name = "2020" Or ws.Name = "2019" Then
secondRowCount = ws.Cells(Rows.count, "D").End(xlUp).row
fromDateArr = ws.Range("D5:D" & secondRowCount).Value
toDateArr = ws.Range("E5:E" & secondRowCount).Value
perilArr = ws.Range("F5:F" & secondRowCount).Value
' For j = 5 to secondRowCount
'For Each j In fromDateArr
'boundary = UBound(fromDateArr)
For j = 1 To UBound(fromDateArr)
' MsgBox (fromDateArr(j))
e = fromDateArr(j, 1)
f = toDateArr(j, 1)
p = perilArr(j, 1)
'e = ws.Cells(j, 4).Value
' f = ws.Cells(j, 5).Value
If d >= e And d <= f Then
' ReDim Preserve resultArr(1 To UBound(resultArr) + 1)
' resultArr(UBound(resultArr), 1) = p
resultArr(count) = p
Exit For
ElseIf j = UBound(fromDateArr) Then
' Worksheets("raw_data_YOA").Cells(i, 63).Value = "FALSE"
' ReDim Preserve resultArr(1 To UBound(resultArr) + 1)
' MsgBox (UBound(resultArr))
resultArr(count) = "FALSE"
End If
Next j
Else
GoTo NextIteration
End If
count = count + 1
NextIteration:
Next
Next i
counter = 0
For Each cell In Sheets("raw_data_YOA").Range("Q2:Q" & rowCount)
cell.Value = resultArr(counter)
counter = counter + 1
Next
MsgBox ("Done")
End Sub
EDIT:
Specifically, the lines throwing the errors are resultArr(count) = ...
I'm trying to get a grasp of the VBA Dictionary.
I believe I have succeeded into storing the text of multiple cells into an array into the dictionary. But I can't find any way to get it out of there.
End goal is the ability to add multiple sources into 1 dictionary and then extract them by key or item or all at once into a new tab.
Here is the code I'm working on:
Sub tutorial_dictionary_Select()
'Must add reference to Tools > References > Microsoft Scripting Runtime
Dim dict As New Dictionary
dict.CompareMode = CompareMethod.TextCompare
Dim source As Worksheet
Set source = ActiveSheet
Dim last_row As Long
last_row = Cells(Rows.Count, 1).End(xlUp).Row
Dim last_col As Long
last_col = ActiveSheet.UsedRange.Columns.Count
Dim i As Long, n As Long
Dim hasHeader As Boolean
Dim arr(0 To 99) As Variant
If IsNumeric(Range("B1").Value) Or IsNumeric(Range("C1").Value) Then
i = 0
Else
hasHeader = True
i = 1
n = 1
For Each rngCell In Range(Cells(1, 2), Cells(1, last_col))
arr(n) = rngCell.Text
'MsgBox arr(n)
Range("I" & n) = arr(n)
Range("J" & n) = n
n = n + 1
Next rngCell
End If
Dim strVal As String
Dim Item(0 To 99) As Variant
Dim header As Range
Dim rng As Range
Dim rngTemp As Range
For Each rngCell In Range(Cells(1 + i, 1), Cells(last_row, 1))
i = i + 1
strVal = rngCell.Text
If Not dict.Exists(strVal) Then
n = 0
For Each headerCell In Range(Cells(i, 2), Cells(i, last_col))
n = n + 1
Item(n) = headerCell.Text
MsgBox headerCell.Text
Next headerCell
dict(strVal) = Item
Else
MsgBox "already exists"
End If
Next rngCell
sFruit = InputBox("Check value of key")
MsgBox "The value of " & sFruit & " is " & dict(sFruit)
The message box gives a type mismatch and I feel like I've tried everything to get those values either put in a cell or debugged and I'm clueless.
As you can see, the code it totally flexible checking for height and width (and a header). And it generates the correct items and their position in the array on the right:
https://i.imgur.com/5Ba6jaN.png
Yes!! That did the trick! I've been stuck on this for days, thank you so much.
Could you maybe elaborate what this code does? The script will run without the first line, but not without the second.
ar = Array()
ReDim ar(lastCol)
In case a key already exists, I want to add the amounts of the 2nd entry to what was already stored in the dictionary. I was able to figure this out myself:
Dim ws As Worksheet
Set ws = ActiveSheet
Dim dict As New Dictionary
Set dict = New Dictionary
dict.CompareMode = TextCompare
Dim lastRow As Long
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Dim lastCol As Long
lastCol = ws.UsedRange.Columns.Count
Dim i As Integer
Dim startRow As Long
startRow = 2
Dim ar As Variant
Dim sKey As String
For iRow = startRow To lastRow
sKey = ws.Cells(iRow, 1).Text
If Not dict.Exists(sKey) Then
ar = Array()
ReDim ar(lastCol)
For i = 2 To lastCol
ar(i) = ws.Cells(iRow, i)
Next
dict(sKey) = ar
Else
ar = dict(sKey)
For i = 2 To lastCol
ar(i) = ar(i) + ws.Cells(iRow, i)
Next
End If
Next
Is this the right way to do it? I expected to do something like dict(sKey)(3) = dict(sKey)(3) + ws.Cells(iRow, 3) but that didn't work.
You can't assign the same array to every key in the dictionary, you have to create a new one each time.
Sub tutorial_dictionary_Select()
'Must add reference to Tools > References > Microsoft Scripting Runtime
Dim dict As New Dictionary
dict.CompareMode = CompareMethod.TextCompare
Dim wb As Workbook, ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.ActiveSheet
Dim last_row As Long, last_col As Long, start_row As Long
Dim hasHeader As Boolean, i As Integer, iRow As Long
last_row = ws.Cells(Rows.Count, 1).End(xlUp).Row
last_col = ws.Range("A1").CurrentRegion.Columns.Count
Debug.Print "last_col", last_col
' check for header
hasHeader = True
start_row = 2
For i = 2 To last_col
If IsNumeric(ws.Cells(1, i)) Then
hasHeader = False
start_row = 1
End If
Next
Dim ar As Variant, sKey As String
For iRow = start_row To last_row
sKey = ws.Cells(iRow, 1).Text
If Not dict.Exists(sKey) Then
ar = Array()
ReDim ar(last_col)
For i = 2 To last_col
ar(i) = ws.Cells(iRow, i)
Next
dict(sKey) = ar
End If
Next
Dim sFruit As String
sFruit = InputBox("Check value of key")
MsgBox "The value of " & sFruit & " is " & dict(sFruit)(3)
End Sub
Okay I've been trying to store my item + properties into an array and then multiple items in an array in a dictionary if that makes sense.
Dim ws As Worksheet
Set ws = ActiveSheet
Dim dict As New Dictionary
Set dict = New Dictionary
dict.CompareMode = TextCompare
Dim lastRow As Long
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Dim lastCol As Long
lastCol = ws.UsedRange.Columns.Count
Dim i As Long, u As Long
Dim startRow As Long
startRow = 2
Dim ar As Variant, items As Variant, item As Variant
Dim sKey As String
Dim itemAdded As Boolean
For iRow = startRow To lastRow
sKey = ws.Cells(iRow, 1).Text
item = ws.Cells(iRow, 2).Text
If Not dict.Exists(sKey) Then
MsgBox "adding new customer"
items = Array()
ReDim items(99)
ar = Array()
ReDim ar(lastCol)
'--------------------
For i = 2 To lastCol
ar(i) = ws.Cells(iRow, i)
Next
items(0) = ar
dict(sKey) = items
Else
MsgBox "customer already exists"
items = dict(sKey)
For u = LBound(items) To UBound(items)
If item = items(u)(2) Then
MsgBox "item already exists"
ar = items(u)
For i = 3 To lastCol
ar(i) = ar(i) + ws.Cells(iRow, i)
Next
items(u) = ar
dict(sKey) = items
itemAdded = True
End If
Next
If Not itemAdded = True Then
MsgBox "adding new item"
For i = 2 To lastCol
ar(i) = ws.Cells(iRow, i)
Next
items(u) = ar
dict(sKey) = items
End If
End If
Next
What is working is that I can recall Items(u)(2) and see the name of an item. But the If item = items(u)(2) Then statement is giving me a type mismatch even though it passes as true on the first loop, why? I tried declaring as String and as Variant but neither combination is working.
https://imgur.com/4eKak8q
Anybody please help me figure my problem out?
Dim attPresent as Variant ' attpresent()
Set ws = thisworkbook.sheets("Sheet1")
lastrow = ws.cells(Rows.count, 8).end(xlup).row
attPresent = ws.Range("H4:H" & lastrow).Value 'errors if I use Dim attPresent() As Variant
For k = LBound(attPresent, 1) To UBound(attPresent, 1) ' Dim attPresent As Variant'errors if I use
msgbox attpresent(k,1)
Next
This line attPresent = ws.Range("H4:H" & lastrow).Value returns an error if I declare the variable as Dim attPresent() As Variant. Whereas, if declare the variable as Dim attPresent As Variant, this line For k = LBound(attPresent, 1) To UBound(attPresent, 1) errors.
Can anyone please help me clear this out?Thanks
As a good practice, try to remember to use Option Explicit, and also declare all your variables.
When you use Dim attPresent() As Variant to declare you array , and later on you insert values from a Range to your Array with attPresent = .Range("H4:H" & lastrow).Value, it will automatically Redim your array to 2-dimensinal array (1 to Row number, 1 to Column Number).
Option Explicit
Sub RngtoArray()
Dim attPresent() As Variant
Dim ws As Worksheet
Dim lastrow As Long
Dim k As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lastrow = .Cells(.Rows.Count, 8).End(xlUp).Row
attPresent = .Range("H4:H" & lastrow).Value
End With
For k = 1 To UBound(attPresent, 1)
MsgBox attPresent(k, 1)
Next
End Sub
Edit 1: A slightly different approach, in case there is only 1 cell in the Range:
With ws
lastrow = .Cells(.Rows.Count, 8).End(xlUp).Row
' for single column only - create a 1-Dimension array
ReDim attPresent(1 To lastrow - 4 + 1) ' when the Range starts from "H4"
For k = 1 To UBound(attPresent)
attPresent(k) = .Cells(4 + k - 1, "H")
Next k
End With
For k = 1 To UBound(attPresent)
MsgBox attPresent(k)
Next
I tried to separate the stuff that you had already defined but for clarity I thought I'd provide my full code:
Sub test()
Dim lastrow, i As Integer
Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets("Sheet1")
Dim attPresent() As Variant
lastrow = ws.Cells(Rows.Count, "H").End(xlUp).Row
ReDim attPresent(lastrow - 4)
For i = 4 To lastrow
attPresent(i - 4) = ws.Range("H" & i).Value
Next
msg = Join(attPresent, " ")
MsgBox "The array holds: " & vbNewLine & msg
End Sub
I defined the array without a size to begin with then redefined it to the size it needs to be at a later stage once you know the lastrow (as you started on 4 i deducted 4 from lastrow).
I guessed the msgBox was to test what you had gathered so I created a dump that prints them all into one box but obviously change that if you have a lot of data. xD
To work with arrays I always loop through each individual entry, storing them one at a time. I'm not even sure whether you can dump an entire range into one in one step as I've never even looked into it. Anyway, I hope this solves your problem kupo.
Function RangeToArray(rng As Range)
Dim myArray() As Variant, ws As Worksheet
fr = rng.Row
fc = rng.Column
r = rng.Rows.Count
c = rng.Columns.Count
Set ws = rng.Worksheet
ReDim myArray(r - 1, c - 1)
For i = 0 To r - 1
For j = 0 To c - 1
myArray(i, j) = ws.Cells(fr + i, fc + j).Value2
Next j
Next i
RangeToArray = myArray
End Function
Sub f()
Dim rng As Range, attPresent() As Variant ' attpresent()
Set ws = ThisWorkbook.ActiveSheet 'Sheets("Sheet1")
lastrow = ws.Cells(Rows.Count, 8).End(xlUp).Row
Set rng = ws.Range("H4:H" & lastrow)
attPresent = RangeToArray(rng)
For k = LBound(attPresent, 1) To UBound(attPresent, 1) ' Dim attPresent As Variant'errors if I use
MsgBox attPresent(k, 0)
Next
End Sub
I created a more generic function that you can call in this specific case as well.