Need someone to QC this VB Script. It seems to have an issue

[Chuckc1960]

This VB Script runs a large Workbook (500+ pages) to lookup names and other info based on an input date. If I keep this on the Server after a few days, I get an Invalid Parameters error and the code is not visible in the workbook anymore. Can someone check the script for any glaring errors?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim a As Variant, b As Variant

Dim SheetList As Range, cell As Range

Dim i As Long, j As Long, k As Long, oset As Long

Dim SearchDate As Date



If Not Intersect(Target, Range("B3")) Is Nothing Then

Application.EnableEvents = False

ActiveSheet.UsedRange.Offset(4).ClearContents

If IsDate(Range("B3").Value) Then

SearchDate = Range("B3").Value

With Sheets("Lookup_Sheets")

Set SheetList = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))

End With

For Each cell In SheetList

With Sheets(cell.Value)

k = 0

a = .Range("I2", .Range("I" & .Rows.Count).End(xlUp).Offset(1)).Resize(, 9).Value '

ReDim b(1 To UBound(a, 1), 1 To 9) '

For i = 1 To UBound(a)

If a(i, 1) = SearchDate Then

k = k + 1

'

For j = 1 To 9

Select Case j

Case Is < 3: oset = 3

Case Is < 6: oset = -2

Case Else: oset = 0

End Select

b(k, j) = a(i, j + oset)

Next j

'***

End If

Next i

End With

If k > 0 Then Me.Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(k, 9).Value = b '

Next cell

End If

Application.EnableEvents = True

End If

Erase a

Erase b

End Sub

 

[Chuckc1960]

Just FYI, I did not write the script.