Getting a subscript out of range error for this code. I'm fairly new to VBA so it may be something very obvious but I can't get it to work:
Sub Actual()
Dim rw As Integer
Dim i As Integer
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wb2 As Workbook
Dim TAmt, VAmt, UAmt, OAmt As Double
Worksheets("Act").Range("G1").Activate
Let rw = ActiveCell
Workbooks.Open Filename:=ThisWorkbook.Path & "\2. 2019 Legacy"
Set wb2 = ThisWorkbook
For i = 0 To 2
wb2.Worksheets("VBA Input").Activate
VAmt = Cells(3 + (i * 5), 9)
UAmt = Cells(4 + (i * 5), 9) + Cells(5 + (i * 5), 9)
TAmt = Cells(6 + (i * 5), 9)
OAmt = Cells(7 + (i * 5), 9)
wb.Worksheets("Act").Activate
Cells(rw + i, 16) = TAmt
Cells(rw + i, 17) = VAmt
Cells(rw + i, 18) = UAmt
Cells(rw + i, 19) = OAmt
Next
End Sub
Debugging highlights the line just after the for loop and gives a subscript out of range error.
Related
My aim is to SumIf in an inactive sheet, store resulting values as array elements and then transpose the array into ThisWorkBook, keeping to minimal visual and processing speed disruption.
Code:
Option Explicit
Option Base 1
Sub BM_Rebal()
Application.ScreenUpdating = False
Application.Calculation = xlManual
' Variables
Dim wb1, wb2, wb3 As Workbook
Dim ws1, ws2, ws3 As Worksheet
Dim wsf As WorksheetFunction
Dim Arr1(1 To 22), Arr2(1 To 22), Arr3(1 To 22), Arr4(1 To 22) As Variant
Dim i, j, k As Integer
Dim A, B, Path1, Path2 As String
Set wsf = Application.WorksheetFunction
Set wb3 = ThisWorkbook
Set ws3 = wb3.Sheets("Currencies")
i = 1
A = Format(ws3.Cells(1, 4), "yyyymmdd")
B = Format(ws3.Cells(1, 3), "yyyymmdd")
Path1 = "[string]" & _
"[string]" & A & ".csv"
Path2 = "[string]" & _
"[string]" & B & ".csv"
Set wb1 = Workbooks.Open(Path1)
Set wb2 = Workbooks.Open(Path2)
Set ws1 = wb1.Sheets("[string]" & A)
Set ws2 = wb2.Sheets("[string]" & B)
' Body
wb3.Activate
'wb1.Activate
With ws1
k = .UsedRange.Columns("BF").Rows.Count
For i = 1 To 22
Arr1(i) = wsf.SumIfs(.Range(.Cells(3, 58), .Cells(k, 58)), _
.Range(.Cells(3, 2), .Cells(k, 2)), ws3.Cells(1, 1), _
.Range(.Cells(3, 68), .Cells(k, 68)), ws3.Cells(i + 2, 1))
Next i
For j = i To 22
Arr2(j) = 100 * ( Arr1(j) / wsf.Sum(Arr1) )
Next j
ws1.Close
End With
'wb2.Activate
With ws2
k = .UsedRange.Columns("BF").Rows.Count
For i = 1 To 22
Arr3(i) = wsf.SumIfs(.Range(.Cells(3, 58), .Cells(k, 58)), _
.Range(.Cells(3, 2), .Cells(k, 2)), ws3.Cells(1, 1), _
.Range(.Cells(3, 68), .Cells(k, 68)), ws3.Cells(i + 2, 1))
Next i
For j = 1 To 22
Arr4(j) = 100 * ( Arr3(j) / wsf.Sum(Arr3) )
Next j
ws2.Close
End With
' Output
With ws3
.Range(.Cells(3, 3), .Cells(24,3)) = Application.Transpose(Arr2)
.Range(.Cells(3, 4), .Cells(24,4)) = Application.Transpose(Arr4)
End With
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
Which 1004 errors here:
Arr1(i) = wsf.SumIfs(.Columns("BF3:BF" & k), .Columns("B3:B" & k), .Cells(1, 1), .Columns("BP3:BP" & k), .Cells(i + 2, 1))
Now, given the msg provides no further detail other than the alert of what error type is occurring, the most likely cause was the position of (in)active sheets, but activating - bringing the relevant sheets forwards - proved unsuccessful and the syntax seems to be referencing the objects properly anyway, without the need to activate (which is ugly).
What is causing this error please?
.Columns("BF3:BF" & k) (to take one instance) should be .Range("BF3:BF" & k)
You need to use Range here instead of Columns, since you're not working with an entire column, but a subset of the column.
One can do Columns(1) or Columns("A") or Columns("A:A"), but not Columns("A1:A10").
BIG PICTURE
Go through a list and create a tab for each item in the list (Working)
Create a hyperlink in the list that links to the associated worksheet (Working)
Create basic header information on each worksheet and hyperlink back to index sheet (Working)
Insert a button for each reference listed in a corresponding cell in the index sheet and hyperlink to that pdf, doc, or docx file (Not working, work in progress)
CURRENT PROBLEM
When calling the sub that will insert buttons I am getting an Object Required error (see image at end).
The main part of the code is as follows:
Sub CreateTabs()
Dim ws As Worksheet
Dim NameArray As Variant
Dim LastRow As Long
Dim x As Long
Dim y As Long
Dim z As Long
Dim ReferenceCount As Long
Dim RefSplit() As Variant
LastRow = FindLastRow
Set ws = ThisWorkbook.Sheets(1)
NameArray = ws.Range(ws.Cells(2, 1), ws.Cells(LastRow, 1)).Value
For x = LBound(NameArray) To UBound(NameArray)
ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = NameArray(x, 1)
'ws.Hyperlinks.Add ws.Cells(x + 1, 1), "", ThisWorkbook.Sheets(NameArray(x, 1)).Cells(1, 1).Address(External:=True), NameArray(x, 1), NameArray(x, 1)
With ThisWorkbook.Sheets(NameArray(x, 1))
ws.Hyperlinks.Add ws.Cells(x + 1, 1), "", .Cells(1, 1).Address(External:=True), .Name, .Name
.Hyperlinks.Add .Cells(1, 1), "", ws.Cells(1, 1).Address(External:=True), "Item List", "ITEM LIST"
.Cells(2, 1) = "Item"
.Cells(3, 1) = "Description"
.Cells(4, 1) = "U.O.M."
.Cells(6, 1) = "Specifications"
.Cells(2, 2).Formula = "=RIGHT(CELL(""filename"",$B$2),LEN(CELL(""filename"",$B$2))-FIND(""]"",CELL(""filename"",$B$2)))"
.Cells(3, 2).Formula = "=VLOOKUP($B$2,Sheet1!$A$2:$D$" & LastRow & ",2,0)"
.Cells(4, 2).Formula = "=VLOOKUP($B$2,Sheet1!$A$2:$D$" & LastRow & ",4,0)"
ReferenceCount = Num_Characters_In_String(ws.Cells(x + 1, 3).Value, ", ") + 1
ReDim RefSplit(1 To ReferenceCount,1)
If ReferenceCount > 1 Then
RefSplit = ReferenceSplit(ws.Cells(x + 1, 3).Value)
Else
RefSplit(1,1) = ws.Cells(x + 1, 3).Value
End If
z = 1
For y = 1 To ReferenceCount
If y > z * 5 Then z = z + 1
'*************************************************************
Call Insertbutton(z, y - (z - 1) * 5, RefSplit(y, 1).Value, ThisWorkbook.Sheets(NameArray(x, 1)))
'*************************************************************
Next y
End With
Next x
End Sub
And the sub that is being called looks as follows for now:
Sub Insertbutton(btnrow As Long, btncol As Long, btnName As String, ws As Worksheet)
Dim btn As Button
Dim rng As Range
Application.ScreenUpdating = False
ws.Buttons.Delete 'probably do not need as it is fresh sheet
Set rng = ws.Cells(btnrow + 6, btncol + 1)
Set btn = ws.Buttons.Add(rng.Left, rng.Top, rng.Width, rng.Height)
With btn
If Left(btnName, 1) = "F" Then
If Num_Characters_In_String(btnName, "-") = 2 Then
.OnAction = "P:\2019\1234-name space\08. Working\Specifications\Section F" & btnName & "*.doc*"
Else
.OnAction = "P:\2019\1234-name space\10. Construction\01. Tender\F\" & btnName & ".pdf"
End If
Else
.OnAction = "P:\2019\1234-name space\10. Construction\01. Tender\OPSS\OPSS*" & btnName & "*.pdf"
End If
.Caption = btnName
.Name = btnName
End With
Application.ScreenUpdating = True
End Sub
QUESTION
What is the missing object? What am I doing wrong with the call?
(I foresee some issues with linking to the files but I have not got to that point in my debugging yet, and that will be a different question. Trying not to muddy the waters so to speak)
I did read this question so I believe the format of the call ( ) is correct, but I could be wrong
RefSplit(y, 1).Value causes an error. RefSplit(y, 1) is correct.
Do not use .value for arrays. Because it is used for range objects, an object error occurs.
Call Insertbutton(z, y - (z - 1) * 5, RefSplit(y, 1).Value, ThisWorkbook.Sheets(NameArray(x, 1)))
However, there is another error, and the type of the argument cannot be matched. String variables should be used.
Dim myString As String
myString = RefSplit(y, 1)
Call Insertbutton(Z, y - (Z - 1) * 5, myString, ThisWorkbook.Sheets(NameArray(x, 1)))
I'm working with userform to add data in a Table "t_database". For each checkbox = true, add a ROW.
When i add some data, appear "Run-time error '9' Subscript out of range..
To create this code, i used a post founded here and i completed with my requeriments.
Option Explicit
Private Sub cmdAddproject_Click()
Dim chkCnt As Integer
Dim ctl As MSForms.Control, i As Integer, lr As Long
Dim cb As MSForms.CheckBox
With Me
chkCnt = .Tool1.Value + .Tool2.Value + .Tool3.Value + .Tool4.Value + .Tool5.Value + .Tool6.Value + .Tool7.Value + .Tool8.Value + .Tool9.Value + .Tool10.Value + .Tool11.Value + .Tool12.Value + .Tool13.Value + .Tool14.Value + .Tool15.Value + .Tool16.Value + .Tool7.Value + .Tool18.Value + .Tool19.Value + .Tool20.Value + .Tool21.Value + .Tool22.Value + .Tool23.Value + .Tool24.Value + .Tool25.Value + .Tool26.Value + .Tool27.Value + .Tool28.Value + .Tool29.Value + .Tool30.Value
chkCnt = Abs(chkCnt)
If chkCnt <> 0 Then
ReDim mval(1 To chkCnt, 1 To 17)
i = 1
For Each ctl In .Controls
If TypeOf ctl Is MSForms.CheckBox Then
Set cb = ctl
If cb Then
mval(i, 1) = .txtProyecto.Value
mval(i, 2) = .txtAno.Value
mval(i, 3) = .txtEmpresa.Value
mval(i, 4) = .SectorEmpresa.Value
mval(i, 5) = .TipoEmpresa.Value
mval(i, 6) = .txtDireccion.Value
mval(i, 7) = .txtCiudad.Value
mval(i, 8) = .txtCodigoPostal.Value
mval(i, 9) = .txtPais.Value
mval(i, 10) = .txtDescripcion.Value
mval(i, 11) = .txtIndicador1.Value
mval(i, 12) = .metrica1.Value
mval(i, 13) = .txtIndicador2.Value
mval(i, 14) = .metrica2.Value
mval(i, 15) = cb.Caption
mval(i, 16) = .txtAhorrosPrevistos.Value
mval(i, 17) = .txtAhorrosObtenidos.Value
i = i + 1
End If
End If
Next
End If
End With
With Sheets("Database")
lr = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & lr).Resize(UBound(mval, 1), 17) = mval
End With
End Sub
I'm writing a VBA function using an input that determines the sheet containing other inputs.
With different curvename, the function should refer to data in different sheets. My code is as below:
Public Function DFrate(mtmdate As Date, pmtdate As Date, curvename As String, colno As Integer) As Double
Dim yf As Double
Dim noday As Integer
Dim lastrow As Integer
Dim rate As Range
Dim tenor As Range
Dim DFinv As Double
Dim DFinv1 As Double
Dim DFinv2 As Double
noday = pmtdate - mtmdate
yf = noday / 360
MsgBox noday
ThisWorkbook.Sheets("HS_" & curvename).Activate
lastrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
Set rate = ActiveSheet.Range(Cells(102, 3 + colno), Cells(lastrow, 3 + colno))
Set tenor = ActiveSheet.Range(Cells(102, 2), Cells(lastrow, 2))
If (noday <= tenor(1, 1)) Then
DFinv1 = (1 + rate(1, 1) / 100) ^ yf
DFinv2 = (1 + rate(2, 1) / 100) ^ yf
DFinv = DFinv1 + (noday - tenor(1, 1)) * (DFinv2 - DFinv1) / (tenor(2, 1) - tenor(1, 1))
MsgBox DFinv
End If
For k = 1 To lastrow
If (noday > tenor(k, 1) And noday <= tenor(k + 1, 1)) Then
DFinv1 = (1 + rate(k, 1) / 100) ^ (tenor(k, 1) / 360)
DFinv2 = (1 + rate(k + 1, 1) / 100) ^ (tenor(k + 1, 1) / 360)
DFinv = DFinv1 + (noday - tenor(k, 1)) * (DFinv2 - DFinv1) / (tenor(k + 1, 1) - tenor(k, 1))
Exit For
End If
Next k
DFrate = DFinv
End Function
I got the error #NAME?
Even the message box "Msgbox noday" does not work.
Can someone please let me know what should be changed in my code? Thanks!
If I:
put the code below (which is slightly different to yours) in a regular module (not Thisworkbook or any of the Sheet modules),
create a worksheet named "HS_O",
put 5 in cell B102 of worksheet "HS_O", put 3 in cell D102 of worksheet "HS_O"
and put =DFrate(TODAY(),TODAY(),"O",1) in any cell of any worksheet within Thisworkbook
I get a return value of 1. I think it works for me (and should work for you too in theory).
Option Explicit
Public Function DFrate(mtmdate As Date, pmtdate As Date, curvename As String, colno As Long) As Double
Dim yf As Double
Dim noday As Long
Dim lastrow As Long
Dim rate As Range
Dim tenor As Range
Dim DFinv As Double
Dim DFinv1 As Double
Dim DFinv2 As Double
Dim k As Long
noday = pmtdate - mtmdate
yf = noday / 360
' Maybe have a defensive check/guard
' or some return particular return value if sheet doesn't exist
With ThisWorkbook.Sheets("HS_" & curvename)
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set rate = .Range(.Cells(102, 3 + colno), .Cells(lastrow, 3 + colno))
Set tenor = .Range(.Cells(102, 2), .Cells(lastrow, 2))
End With
If (noday <= tenor(1, 1)) Then
DFinv1 = (1 + rate(1, 1) / 100) ^ yf
DFinv2 = (1 + rate(2, 1) / 100) ^ yf
DFinv = DFinv1 + (noday - tenor(1, 1)) * (DFinv2 - DFinv1) / (tenor(2, 1) - tenor(1, 1))
MsgBox DFinv
End If
For k = 1 To lastrow
If (noday > tenor(k, 1) And noday <= tenor(k + 1, 1)) Then
DFinv1 = (1 + rate(k, 1) / 100) ^ (tenor(k, 1) / 360)
DFinv2 = (1 + rate(k + 1, 1) / 100) ^ (tenor(k + 1, 1) / 360)
DFinv = DFinv1 + (noday - tenor(k, 1)) * (DFinv2 - DFinv1) / (tenor(k + 1, 1) - tenor(k, 1))
Exit For
End If
Next k
DFrate = DFinv
End Function
I don't deal with calling UDFs from the worksheet much. Maybe merely calling the function activates the sheet the function is on, and not the "HS_" & curvename worksheet. I don't know for sure. Either way, we can use a With statement.
This is the updated code. I am getting a mismatch error now. It would be great if someone could offer some help. Thanks in advance!
Sub Macro2()
Dim rowcount As Long
Dim target As Variant, startcell4 As Range
Set startcell4 = ActiveSheet.Cells(2, 1)
rowcount = Range(Range("E2"), Range("E2").End(xlDown)).Rows.Count
For i = 2 To rowcount + 1
If Not ActiveSheet.Cells(i, 26) = ActiveSheet.Cells(i + 1, 26) Then
Set target = Application.Match(ActiveSheet.Cells(i, 26), Worksheets(19).Range("A6:A3000"), 0)
If Not IsError(target) Then
ActiveSheet.startcell4.Offset(0, 17).Value = Worksheets(19).Cells(target + 6, 10)
Set startcell4 = ActiveSheet.Cells(i + 1, 26)
End If
End If
Next i
End Sub
Changed:
"Set target = ..." to "target = ..."
"ActiveSheet.startcell4" to "startcell4"
A little refactoring
Coming to this
Sub Macro2()
Dim rowcount As Long
Dim target As Variant, startcell4 As Range
Set startcell4 = Cells(2, 1)
rowcount = Range("E2").End(xlDown).Row
For i = 2 To rowcount
If Not Cells(i, 26) = Cells(i + 1, 26) Then
target = Application.Match(Cells(i, 26), Worksheets(19).Range("A6:A3000"), 0)
If Not IsError(target) Then
startcell4.Offset(0, 17).Value = Worksheets(19).Cells(target + 6, 10)
Set startcell4 = Cells(i + 1, 26)
End If
End If
Next i
End Sub