Run time error '9' VBA Subcript out of range - vba

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