Why do I get a "Subscript out of range" error when trying to access my array in this macro? Looping through the array using something like for each v in a then debug.print v works fine, but when trying to access it using the index, I get the error shown in the screenshot below:
The macro itself looks like this, and the line throwing the error is If DateValue(a(i)) = DateValue(t) Then
Option Explicit
Option Base 0
Sub gå_til_flik()
Dim t As Date
Dim a() As Variant
Dim i As Long
t = Now
a = Plan_Å1_endeleg.Range("B3:B" & Plan_Å1_endeleg.Range("B" & Plan_Å1_endeleg.Rows.Count).End(xlUp).Row)
For i = LBound(a) To UBound(a)
If DateValue(a(i)) = DateValue(t) Then
Exit For
End If
Next i
End Sub
Related
For reasons unbeknownst to me, I am getting an error on a dynamic array with in a macro. It keeps saying "Subscript out of range". But - here's the kicker - if I run the same macro again after the error is displayed, then it would not complain. Here is the piece of code that I have
Both the arrays (arrTemp and arrPBIs) are declared as in a separate module along with the rest of the variables:
Public arrPBIs() As Variant
Public arrTemp() As Variant
arrTemp = Worksheets("Prioritized PBIs Only").Range("B2:B6").Value
ReDim arrPBIs(UBound(arrTemp))
For iRw = 1 To UBound(arrTemp)
If arrTemp(iRw, 1) <> "" Then
x = x + 1
arrPBIs(x) = arrTemp(iRw, 1)
End If
Next iRw
ReDim Preserve arrPBIs(x)
Where am I going wrong? Thanks in advance for your assistance.
As a more general answer to using arrays in VBA and getting arrays from Excel into VBA the following code may be helpful. You need to have the locals and immediate windows open when you run the code.
Option Explicit
Sub ArrayDemo()
Dim VBAArray As Variant
Dim ExcelArray As Variant
Dim ExcelArray2D As Variant
Dim TransposedExcelArray As Variant
' Excel is setup to have 10 to 50 step 10 in A1:A5
' and 100 to 500 step 100 in B1:B5
VBAArray = Array(1, 2, 3, 4, 5)
ExcelArray = ActiveSheet.Range("A1:A5").Value
ExcelArray2D = ActiveSheet.Range("A1:B5").Value
TransposedExcelArray = WorksheetFunction.Transpose(ActiveSheet.Range("A1:A5").Value)
On Error Resume Next
Debug.Print ExcelArray(1) ' gives an error
Debug.Print "Error was", Err.Number, Err.Description
Err.Clear
On Error Resume Next
Debug.Print TransposedExcelArray(1) ' works fine
Debug.Print "Error was", Err.Number, Err.Description
Dim myItem As Variant
For Each myItem In ExcelArray2D
Debug.Print myItem
Next
Stop ' Look in the locals window for how the arrays are setup
End Sub
I got stumped by a rather weired behaviour of Excel (tested on Office Pro 2016 and Office 365).
It appears as if Name.RefersToRange breaks when referring to a non-contiguous range.
See this test procedure
Public Sub test()
Dim n As Name
With ActiveWorkbook
For Each n In .Names ' remove all preexisting names
n.Delete
Next n
Call .Names.Add("rPass", "=Sheet1!$A$1:$C$3") ' create a new contiguous named range
Call .Names.Add("rFail", "=Sheet1!$A$1,Sheet1!$C$3") ' create a new non-contigous named range
Debug.Print .Names("rPass").RefersTo ' runs fine Output: =Sheet1!$A$1:$C$3
Debug.Print .Names("rPass").RefersToRange.Address ' runs fine Output: $A$1:$C$3
Debug.Print .Names("rFail").RefersTo ' runs fine Output: =Sheet1!$A$1,Sheet1!$C$3
Debug.Print .Names("rFail").RefersToRange.Address ' crashes with Error 1004
End With
End Sub
I found a clumsy workaround like this
Public Function FunkyRefersToRange(rng As Name) As Range
Dim r As Range
Set r = Range(Mid(rng, 2)) ' create a local range by stripping the leading equal sign of the reference
Set FunkyRefersToRange = r
End Function
With that you can now write (as long the correct worksheet is selected)
Debug.Print FunkyRefersToRange(.Names("rFail")).Address
But I'd like to understand why non-contiguous ranges cannot be referenced via Name.RefersToRange and how to overcome that limitation more elegantely than shown above.
It should work like this:
Sub WhatsInaName()
Dim disJoint As Range, N As Name, addy As String
Set disJoint = Range("A1,B9")
disJoint.Name = "jim"
Set N = disJoint.Name
addy = N.RefersToRange.Address
MsgBox disJoint.Address & vbCrLf & addy
End Sub
Can you replicate my result on your computer?
I am having a very strange problem. I am not able to get the value returned from a simple function as below if the return value is more than one char. Now the second problem is that following code is not assigning "WTH" to sheetName variable. Refer to the screenshot 2. UPDATED AFTER CYRIL'S COMMENTS
Public Sub WTHFormatter()
Dim sheetName As String
sheetName = "WTH"
Dim rng1 As Range
'delete empty rows
lastRowWTH = getLastRow(sheetName, 2)
'Delete rows below the last Row
Worksheets(sheetName).Rows(lastRowWTH + 1 & ":" & Worksheets(sheetName).Rows.Count).Delete
' build first range
Set rng1 = Worksheets(sheetName).Range("B11:F" & lastRowWTH)
Call setCellBorders(rng1)
Set rng1 = Worksheets(sheetName).Range("H11:K" & lastRowWTH)
Call setCellBorders(rng1)
'determine the range for months
For i = 13 To 24
If Cells(7, i) = "" Then
lastCol = i - 1
Exit For
End If
lastCol = i
Next
ColLetter = returnLabel(lastCol)
ColLetter2 = returnLabel(lastCol + 2)
ColLetterX = returnLabel(lastCol + 14)
Set rng1 = Worksheets(sheetName).Range("K17:" & ColLetter & lastRowWTH)
Call setCellBorders(rng1)
Set rng1 = Worksheets(sheetName).Range(ColLetter2 & lastRowWTH & ":" & ColLetter3 & lastRowWTH)
Call setCellBorders(rng1)
End Sub
Function returnLabel(num1 As Long) As String
Dim ColumnLetter As String
ColumnLetter = Split(Cells(1, num1).Address, "$")(1)
returnLabel = ColumnLetter
End Function
The above function returns blank and varTest has nothing after the execution. If I do the line by line execution, I see that test1 in function is not 'Null'.
If I break the execution and probe the variables I see "test1 =" only as per the screen shot below. And this is breaking my code.
Strangely, If I call the function from 'Immediate Window', it returns the expected value.
Things I have already done:
I have tested in a fresh file using simple code as above.
Tested in different PC and the same code is working fine with same version of Windows 10 & Office 365.
Updated / Re-installed MS Office 365
Restarted the PC
If the return value is a single character like "A", the code is working fine.
Failed to understand the reason here. Any help is appreciated.
UPDATE1
I tried it on a fresh file while the code above worked, but the main code is having a new similar problem. This has started happening just now. It's not assigning a string value to the variable. See the attached screenshot.Screenshot of the VBA Code. I am assuming there is some problem with system or some virus.
If the idea is to have a function, that an array, this is possible with the following code:
Function Test1() As Variant
ReDim result(2)
result(0) = "AJ"
result(1) = "A"
Test1 = result
End Function
Sub Main()
Dim varTest As Variant
varTest = Test1(0)
Debug.Print varTest
varTest = Test1(1)
Debug.Print varTest
End Sub
It is questionable why would it be needed, but as a "test-exercise" it is ok.
Going to put my comments into an answer to consolidate and add more explanation.
Pointing out some errors in the code before correcting:
Function test1(num1) 'declare `as variant` to ensure you're returning an array
test1 = "AJ" 'this appears to be saving a single string to var test1
test1 = "A" 'you are now overwriting the above string
End function
Sub test()
varTest = test1(1) 'you have a single string from the function and arrays start at 0, not 1
End sub
You would want to specify the place in the array, after declaring an array, within your function such that:
Function test1() As Variant
Dim arr(2) As Variant 'added array because test1 = BLAH is the final output in a function
arr(0) = "AJ" 'added (1) to call location in array
arr(1) = "A" 'added (2) to call location in array
test1 = arr
End Function
Sub test()
Dim varTest As Variant
varTest = test1(0) 'outputs "AJ" in immediate window
Debug.Print varTest
End Sub
Now you can debug.print your array values, or set to varTest based on the location in the array.
Edit: Tested after my consolidating comments and recognized that there was not an actual output for test1 as an array at the end of the function, so had to go back and add a second array to set test = allowing an array output from a function.
Your code is running as it should.
The test1 function assigns the value AJ to the test1 variable, and then it assigns the value A to the test1 variable.
You could assign the value 50 in your test procedure and it will return A.
I think this is the code you're after:
Function test1(num1) As String
' Dim MyArray As Variant
' MyArray = Array("AJ", "A")
'OR
Dim MyArray(0 To 1)
MyArray(0) = "AJ"
MyArray(1) = "A"
If num1 >= LBound(MyArray) And num1 <= UBound(MyArray) Then
test1 = MyArray(num1)
Else
test1 = "Item not here"
End If
End Function
Sub test()
Dim varTest As String
'Return the second item in the array from the function.
varTest = test1(1)
MsgBox varTest
'Return the first item in the array from the function.
varTest = test1(0)
MsgBox varTest
'Returns "subscript out of range" error as array is only 2 elements in size (0 and 1).
'The error is dealt with in the function using the IF....ELSE...END IF block and returns
'"Item not here" instead.
varTest = test1(2)
MsgBox varTest
End Sub
I solved this by using declaring the variables even when option explicit is not used.
The old code runs without throwing errors even when the variable is not declared and option explicit is also not used. But, for some reasons, it doesn't read / write undeclared variables as expected.
Now as per #cyril suggestion, I declared the variables being used and run the code. This time code ran as expected.
This happened for multiple of variables and at different stages in the code.
I want to update a line in my table based on a cell in another sheet, and to that end I intend to use the index match function. When I run the code below I get the error that it cannot get the property of the match function class.
What is the correct syntax in this regard?
Sub Update_Customer()
' Declarations
Dim rng as listobject
Dim wf as application.worksheetfunction
Dim cs_sht as string
Set rng = Sheets(1).ListObjects("Table_Customer")
Set ws = ThisWorkbook.ActiveSheet
cs_sht = ws.Name
' ERROR RUNNING THIS LINE vvvvv
wf.Index(rng.ListColumns("Firstname"), wf.Match(cs_sht, rng.ListColumns("Customer ID"), 0)) = ws.Range("C_Firstname").Value
End Sub
Excel functions need to be nested, because a cell's value needs to be parsed as a single step.
VBA code doesn't need to do that. VBA instructions work best and are easier to debug when you split them and make them do as little work as possible.
So instead of this:
wf.Index(rng.ListColumns("Firstname"), wf.Match(cs_sht, rng.ListColumns("Customer ID"), 0))
Split it up:
Dim matchResult As Long
matchResult = WorksheetFunction.Match(cs_sht, rng.ListColumns("Customer ID").DataBodyRange, 0)
Dim indexResult As Variant
indexResult = WorksheetFunction.Index(rng.ListColumns("FirstName").DataBodyRange, matchResult)
Note that you'll get a run-time error if either function fails to find what it's looking for. Use On Error to handle that case:
On Error GoTo CleanFail
Dim matchResult As Long
matchResult = WorksheetFunction.Match(...)
...
Exit Sub
CleanFail:
MsgBox "Could not find record for '" & cs_sht & "'." & vbNewLine & Err.Description
End Sub
Get rid of wf. There's no use to copy object references of objects that are already global. The fewer global variables you use, the better.
if the first name changes I can update the table to match the new name from my worksheet
You can't just assign the indexResult to a new value. The indexResult isn't holding a reference to any cell, it's just the result of the INDEX worksheet function. You need to use that result to get the cell you want to modify:
Dim targetCell As Range
Set targetCell = rng.ListColumns("FirstName").DataBodyRange.Cells(indexResult)
targetCell.Value = ws.Range("C_Firstname").Value
I am trying to pass an array to the pivot table fields, but on doing so excel throws a run time error:1004 error "Application defined or object defined error". Below is the piece of code I have written in VBA:
Sub ARRAYER()
Dim i As Double
Dim ALM(8) As String
Sheet15.PivotTables("significance_pivot2").PivotFields("Pagename"). _
ClearAllFilters
For i = 1 To 8
ALM(i) = CStr(Sheet4.Range("F" + CStr(i + 2) + "").Text)
Next
For i = 1 To 8
Sheet4.Range("AA" & i).Value = ALM(i)
Next i
Sheet15.PivotTables("significance_pivot2").PivotFields("Pagename").VisibleItemsList = Array(ALM)-- It trows an error here!!!
End Sub
maybe try an alternative like this:
Sub ARRAYER()
Dim i As Double
Dim ALM() As String ' dimensioned automatically by VBA on assignment from Range
Sheet15.PivotTables("significance_pivot2").PivotFields("Pagename"). _
ClearAllFilters
ALM = CStr(Sheet4.Range("F3:F11".value)
' maybe just copy the source data directly?
range("F3:F11").copy destination:= range("AA3")
Sheet15.PivotTables("significance_pivot2").PivotFields("Pagename").VisibleItemsList = Array(ALM())-- Changed to add brackets
End Sub