Run time error '9' VBA Subcript out of range

Question

I interited a sheet at work and there is no one who actually supports anything Excel related. My VBA is rather rusty and hence I hope that someone can help me out here.

I have the following code: It goes in error at line If mesi(mese) = "JAN" Then anno = Int(Right(oggi, 2)) + 1 Else anno = Int(Right(oggi, 2)) and i get Run-time error '9': Subscript out of range I have not changed anything and it used to work for a long time. I really appreciate any input

Many thanks

Public Function Pulsante1_Click()


Dim oggi As Date
Dim mesi(1 To 12) As String
Dim prossima_data As String
Dim squarto, sstagione As String
Dim sqa As Range
Dim valore As Double
Dim r As Integer
Dim c As Integer
Dim quarto As Integer
Dim mesi_spalm() As String
Dim valori_spalm() As Double
Dim valor() As Double



Dim anno, mese As Integer


ActiveSheet.Range("J2:K1000000").ClearContents
ActiveSheet.Range("M2:N1000000").ClearContents
ActiveSheet.Range("P2:Q1000000").ClearContents
ActiveSheet.Range("J2:K1000000").Interior.ColorIndex = xlNone
ActiveSheet.Range("M2:N1000000").Interior.ColorIndex = xlNone
ActiveSheet.Range("P1:Q1000000").Interior.ColorIndex = xlThemeColorLight2


mesi(1) = "JAN"
mesi(2) = "FEB"
mesi(3) = "MAR"
mesi(4) = "APR"
mesi(5) = "MAY"
mesi(6) = "JUN"
mesi(7) = "JUL"
mesi(8) = "AUG"
mesi(9) = "SEP"
mesi(10) = "OCT"
mesi(11) = "NOV"
mesi(12) = "DEC"


oggi = Date

mese = (Int(Mid(oggi, 4, 2)) + 1) Mod 12

If mesi(mese) = "JAN" Then anno = Int(Right(oggi, 2)) + 1 Else anno = Int(Right(oggi, 2))


prossima_data = mesi(mese) & Right(anno, 1)

'MsgBox (prossima_data)


If ActiveSheet.Cells(29, 5) = oggi Then

ActiveSheet.Cells(2, 10) = oggi + 1
ActiveSheet.Cells(2, 11) = ActiveSheet.Cells(29, 3)

i = 3
Else


i = 2
End If

If (ActiveSheet.Cells(3, 2) = prossima_data) And (ActiveSheet.Cells(3, 5) = Date) Then


ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(3, 3)

i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If


If InStr(ActiveSheet.Cells(4, 2), "#N/A") = 0 And (ActiveSheet.Cells(4, 5) = Date) Then

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(4, 3)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If

End If

If InStr(ActiveSheet.Cells(5, 2), "#N/A") = 0 And (ActiveSheet.Cells(5, 5) = Date) Then

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(5, 3)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If

End If

If InStr(ActiveSheet.Cells(6, 2), "#N/A") = 0 And (ActiveSheet.Cells(6, 5) = Date) Then

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(6, 3)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If

End If

If InStr(ActiveSheet.Cells(7, 2), "#N/A") = 0 And (ActiveSheet.Cells(7, 5) = Date) Then

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(7, 3)
i = i + 1

mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If

End If



ElseIf ActiveSheet.Cells(4, 2) = prossima_data And (ActiveSheet.Cells(4, 5) = Date) Then



ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(4, 3)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If


If InStr(ActiveSheet.Cells(5, 2), "#N/A") = 0 And (ActiveSheet.Cells(5, 5) = Date) Then

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(5, 3)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If

End If

If InStr(ActiveSheet.Cells(6, 2), "#N/A") = 0 And (ActiveSheet.Cells(6, 5) = Date) Then

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(6, 3)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If

End If

If InStr(ActiveSheet.Cells(7, 2), "#N/A") = 0 And (ActiveSheet.Cells(7, 5) = Date) Then

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(7, 3)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If


End If




End If


'MsgBox (mese & " " & anno)



'cercare in foglio reuters il quarter e se la data è di oggi allora moltiplicare il suo valore per i pesi in valori_spalm per ottenere i singoli valori mese


quarto = WorksheetFunction.Ceiling(mese / 3, 1)
squarto = quarto & "Q" & anno

r = 1
c = 1

Set sqa = ActiveSheet.Range("B10:B16").Find(squarto, LookIn:=xlValues)
If Not sqa Is Nothing Then
    r = sqa.Row
    c = sqa.Column
End If

While Not sqa Is Nothing And ActiveSheet.Cells(r, c + 3) = Date

If Not sqa Is Nothing And ActiveSheet.Cells(sqa.Row, sqa.Column + 3) = Date Then

valore = ActiveSheet.Cells(sqa.Row, sqa.Column + 1)

ReDim mesi_spalm(1 To 3)

Select Case quarto
Case 1
    mesi_spalm(1) = mesi(1) & anno
    mesi_spalm(2) = mesi(2) & anno
    mesi_spalm(3) = mesi(3) & anno
Case 2
    mesi_spalm(1) = mesi(4) & anno
    mesi_spalm(2) = mesi(5) & anno
    mesi_spalm(3) = mesi(6) & anno
Case 3
    mesi_spalm(1) = mesi(7) & anno
    mesi_spalm(2) = mesi(8) & anno
    mesi_spalm(3) = mesi(9) & anno
Case 4
    mesi_spalm(1) = mesi(10) & anno
    mesi_spalm(2) = mesi(11) & anno
    mesi_spalm(3) = mesi(12) & anno
End Select

For j = 1 To 3
If mesi(mese) & anno = mesi_spalm(j) Then Exit For
Next j

If j > 1 Then ReDim valor(1 To (j - 1)) Else ReDim valor(0)

For pp = 1 To (j - 1)

valor(pp) = ActiveSheet.Cells(i - pp, 11)

Next pp



valori_spalm = spalma_mesi(mesi_spalm, valor, valore)


For k = j To 3
ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = valori_spalm(k)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If
Next k


End If

quarto = WorksheetFunction.Ceiling(mese / 3, 1)
squarto = quarto & "Q" & anno

r = 1
c = 1

Set sqa = ActiveSheet.Range("B10:B16").Find(squarto, LookIn:=xlValues)
If Not sqa Is Nothing Then
    r = sqa.Row
    c = sqa.Column
End If

Wend



'MsgBox (mese & " " & anno)



'cercare in foglio reuters il season e se la data è di oggi allora moltiplicare il suo valore per i pesi in valori_spalm per ottenere i singoli valori mese



If mese < 10 And mese >= 4 Then sstagione = "S-" & anno Else sstagione = "W-" & anno


r = 1
c = 1

Set sqa = ActiveSheet.Range("B19:B20").Find(sstagione, LookIn:=xlValues)
If Not sqa Is Nothing Then
    r = sqa.Row
    c = sqa.Column
End If

While Not sqa Is Nothing And ActiveSheet.Cells(r, c + 3) = Date

If Not sqa Is Nothing And ActiveSheet.Cells(sqa.Row, sqa.Column + 3) = Date Then

valore = ActiveSheet.Cells(sqa.Row, sqa.Column + 1)

ReDim mesi_spalm(1 To 6)

Select Case InStr(sstagione, "S-")
Case Is > 0
    mesi_spalm(1) = mesi(4) & anno
    mesi_spalm(2) = mesi(5) & anno
    mesi_spalm(3) = mesi(6) & anno
    mesi_spalm(4) = mesi(7) & anno
    mesi_spalm(5) = mesi(8) & anno
    mesi_spalm(6) = mesi(9) & anno
Case Is = 0
    mesi_spalm(1) = mesi(10) & anno
    mesi_spalm(2) = mesi(11) & anno
    mesi_spalm(3) = mesi(12) & anno
    mesi_spalm(4) = mesi(1) & (anno + 1)
    mesi_spalm(5) = mesi(2) & (anno + 1)
    mesi_spalm(6) = mesi(3) & (anno + 1)
End Select

For j = 1 To 6
If mesi(mese) & anno = mesi_spalm(j) Then Exit For
Next j


If j > 1 Then ReDim valor(1 To (j - 1)) Else ReDim valor(0)

For pp = 1 To (j - 1)

valor(pp) = ActiveSheet.Cells(i - pp, 11)

Next pp

valori_spalm = spalma_mesi(mesi_spalm, valor, valore)


For k = j To 6
ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = valori_spalm(k)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If
Next k


End If

If mese < 10 And mese >= 4 Then sstagione = "S-" & anno Else sstagione = "W-" & anno

r = 1
c = 1
Set sqa = ActiveSheet.Range("B19:B20").Find(sstagione, LookIn:=xlValues)
If Not sqa Is Nothing Then
    r = sqa.Row
    c = sqa.Column
End If

Wend




'MsgBox (mese & " " & anno)




'cercare in foglio reuters il year e se la data è di oggi allora moltiplicare il suo valore per i pesi in valori_spalm per ottenere i singoli valori mese




r = 1
c = 1

Set sqa = ActiveSheet.Range("B23:B26").Find("20" & anno, LookIn:=xlValues)
If Not sqa Is Nothing Then
    r = sqa.Row
    c = sqa.Column
End If

While Not sqa Is Nothing And ActiveSheet.Cells(r, c + 3) = Date

If Not sqa Is Nothing And ActiveSheet.Cells(sqa.Row, sqa.Column + 3) = Date Then

valore = ActiveSheet.Cells(sqa.Row, sqa.Column + 1)

ReDim mesi_spalm(1 To 12)


    mesi_spalm(1) = mesi(1) & anno
    mesi_spalm(2) = mesi(2) & anno
    mesi_spalm(3) = mesi(3) & anno
    mesi_spalm(4) = mesi(4) & anno
    mesi_spalm(5) = mesi(5) & anno
    mesi_spalm(6) = mesi(6) & anno
    mesi_spalm(7) = mesi(7) & anno
    mesi_spalm(8) = mesi(8) & anno
    mesi_spalm(9) = mesi(9) & anno
    mesi_spalm(10) = mesi(10) & anno
    mesi_spalm(11) = mesi(11) & anno
    mesi_spalm(12) = mesi(12) & anno

For j = 1 To 12
If mesi(mese) & anno = mesi_spalm(j) Then Exit For
Next j

If j > 1 Then ReDim valor(1 To (j - 1)) Else ReDim valor(0)

For pp = 1 To (j - 1)

valor(pp) = ActiveSheet.Cells(i - pp, 11)

Next pp

valori_spalm = spalma_mesi(mesi_spalm, valor, valore)



For k = j To 12
ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = valori_spalm(k)
i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If
Next k


End If

r = 1
c = 1
Set sqa = ActiveSheet.Range("B23:B26").Find("20" & anno, LookIn:=xlValues)
If Not sqa Is Nothing Then
    r = sqa.Row
    c = sqa.Column
End If

Wend


'MsgBox (mese & " " & anno)

tro = mesi(mese) & anno
Set sqa = ThisWorkbook.Sheets("ICE").Range("A:A").Find(tro, LookIn:=xlValues)

While Not sqa Is Nothing

ActiveSheet.Cells(i, 10) = mese & "/20" & anno
ActiveSheet.Cells(i, 11) = ThisWorkbook.Sheets("ICE").Cells(sqa.Row, 5) / 1000
ActiveSheet.Cells(i, 10).Interior.Color = RGB(0, 255, 255)
ActiveSheet.Cells(i, 11).Interior.Color = RGB(0, 255, 255)

i = i + 1
mese = mese + 1
If mese = 13 Then
    mese = 1
    anno = anno + 1
End If


tro = mesi(mese) & anno
Set sqa = ThisWorkbook.Sheets("ICE").Range("A:A").Find(tro, LookIn:=xlValues)
Wend

Pulsante3_Click

End Function


Public Function spalma_mesi(mesi() As String, valo() As Double, media_imp As Double) As Variant

Dim sm() As Double
Dim variazione() As Double
Dim media As Double
Dim nummes As Integer
Dim trov As Range

ReDim sm(1 To UBound(mesi))
ReDim variazione(1 To UBound(mesi))

media_imp = media_imp * 1000

media = 0
nummes = 0

For i = LBound(mesi) To UBound(mesi)
Set trov = ThisWorkbook.Sheets("ICE").Range("A:A").Find(mesi(i), LookIn:=xlValues)

If Not trov Is Nothing Then
    If Not IsEmpty(valo) And i <= UBound(valo) Then sm(i) = valo(i) * 1000 Else sm(i) = ThisWorkbook.Sheets("ICE").Cells(trov.Row, trov.Column + 4)
    variazione(i) = ThisWorkbook.Sheets("ICE").Cells(trov.Row, trov.Column + 4)
    media = media + variazione(i)
    nummes = nummes + 1
End If

Next i

media = media / nummes

For ll = LBound(mesi) To UBound(mesi)

variazione(ll) = 1 - (variazione(ll) - media) / media

Next ll




For i = UBound(valo) + 1 To UBound(sm)


sm(i) = (1 - (media - sm(i)) / media) * media_imp

Next i


nummes = 0
media = 0

For i = LBound(sm) To UBound(sm)
nummes = nummes + 1
media = media + sm(i)
Next i
media = media / nummes


While Abs(media - media_imp) > 0.1

va = media_imp - media

For i = UBound(valo) + 1 To UBound(sm)
If va > 0 Then sm(i) = sm(i) + 0.1 Else sm(i) = sm(i) - 0.1
Next i

nummes = 0
media = 0

For i = LBound(sm) To UBound(sm)
nummes = nummes + 1
media = media + sm(i)
Next i
media = media / nummes

Wend

For i = LBound(sm) To UBound(sm)
sm(i) = sm(i) / 1000
Next i


spalma_mesi = sm

End Function

Answer 1

Because, as @Skaterhaz stated, LBOUND(mesi) equals 1 and (Int(Mid(12, 4, 2)) + 1) will return 0 you will need to add one to your formula.

Dim mesi(1 To 12) As String

mese = (Int(Mid(oggi, 4, 2)) + 1) Mod 12 + 1