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

Chuckc1960

New Member
Joined
Mar 20, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

Watch MrExcel Video

Forum statistics

Threads
1,129,809
Messages
5,638,482
Members
417,027
Latest member
wlknspc7

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top