HI everyone.

The folowing code is bugging out on me 'subscript out of range: cant figure out why.

Can someone please tell me the possible reasons / solutions??

YOU DONT NEED TO SEE MOST OF THIS CODE...I WILL HIGHLIGHT WHERE IT BUGS

Option Explicit
Sub test()
Dim a, b, i As Long, j As Long, m As Long, n As Long, icell
Application.ScreenUpdating = False
a = Range([a1], Cells([a1].End(xlDown).Row, 118)):

ReDim b(1 To 65536, 1 To 3):
j = 2

For i = 2 To UBound(a)
    If WorksheetFunction.CountBlank(Range("b" & i & ":h" & i)) < 97 Then
    b(j, 1) = "Zone:":
    b(j, 2) = i - 1:
    b(j, 3) = "Station Equipment":
    j = j + 1
        For m = 14 To 97
            If a(i, m) <> "" Then
                Do
                    b(j, 3) = a(1, m):
                    n = n + 1:
                    j = j + 1
                Loop Until n = a(i, m):
                n = 0
            End If
        Next: b(j, 2) = "Total Cost:":
        j = j + 5
        
       

    End If
    
Next
Sheets.Add: ActiveSheet.Name = "Report":
Range([a1], Cells(j, 3)) = b
Call AmountProduct:

On Error Resume Next

For Each icell In [b:b].SpecialCells(xlCellTypeConstants, 3)
    If IsNumeric(icell.Value) Then
        icell.Offset(, 2) = "Part Number":
        icell.Offset(, 3) = "Cost"
           With Range(icell.Offset(, -1), icell.Offset(, 3)).Font:
        .Bold = True:
        .ColorIndex = 1:
        End With
    Else
        With icell.Offset(, 2):
        .Value = icell.Value:
        .Font.Bold = True:
        .Font.ColorIndex = 1:
        End With
        icell.Offset(, 3) = WorksheetFunction.Sum(Range(icell.Offset(-1, 3), icell.Offset(-1, 3).End(xlUp)))
        icell.Clear
    End If
   
Next: [a:g].EntireColumn.AutoFit:

Call Information

On Error GoTo 0:
Application.ScreenUpdating = True:

End Sub
Sub Information()

    Sheets("Report").Select
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    
    'Zone vlookup
    Range("C2:C4000").Formula = "=IF(ISNA(VLOOKUP(R[-1]C2,'Order Sheet'!R2C1:R4000C7,4,FALSE)),"""",(VLOOKUP(R[-1]C2,'Order Sheet'!R2C1:R4000C7,4,FALSE)))"
    Columns("C:C").Select
    Columns("C:C").Font.Bold = True:
    Columns("C:C").Font.ColorIndex = 3:
    Columns("C:C").EntireColumn.AutoFit
    
    'Stn Desc vlookup
    Range("D2:D4000").Formula = "=IF(ISNA(VLOOKUP(R[-1]C2,'Order Sheet'!R2C1:R4000C7,2,FALSE)),"""",(VLOOKUP(R[-1]C2,'Order Sheet'!R2C1:R4000C7,2,FALSE)))"
    Columns("D:D").Select
    Columns("D:D").Font.Bold = True:
    Columns("D:D").Font.ColorIndex = 3:
    Columns("D:D").EntireColumn.AutoFit
    
    'Tidy up columns
    Columns("A:B").Select
    Selection.EntireColumn.Hidden = False
    Range("C1:D1").Select
    Selection.Delete Shift:=xlUp
    Range("I1").Select
    
    'Currency format for column G
    Columns("G:G").Select
    Columns("G:G").NumberFormat = "$#,##0.00"
    
End Sub



Sub AmountProduct()
Dim cn As New ADODB.Connection, rs As New ADODB.Recordset:
Application.ScreenUpdating = False
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.Path & "\" & ActiveWorkbook.Name & ";Extended Properties=""Excel 8.0;HDR=No;"";"
rs.Open "SELECT T1.F2,T1.F3 FROM `Report$C2:C65000` T2 LEFT OUTER JOIN `Price List$A2:C65536` T1 on T2.F1=T1.F1", cn, adOpenStatic, adLockReadOnly
[d2].CopyFromRecordset rs: Set rs = Nothing: Set cn = Nothing: End Sub