VBA
Need to find errors in this excel VBA Code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = Me
Dim selectedQueue As String
Dim col As Integer
Dim cell As Range
Dim queueFound As Boolean
Dim i As Long
‘ Handle queue selection in cell A1
If Not Intersect(Target, Range(“A1”)) Is Nothing Then
selectedQueue = ws.Range(“A1”).Value
queueFound = False
‘ Unhide/hide columns based on queue selection
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
‘ Loop through columns G to CZ
For col = 7 To 104
If ws.Cells(5, col).MergeCells Then
Set cell = ws.Cells(5, col).MergeArea
If Not IsError(cell.Cells(1, 1).Value) And Not IsEmpty(cell.Cells(1, 1).Value) Then
If Trim(CStr(cell.Cells(1, 1).Value)) = Trim(selectedQueue) Or Trim(selectedQueue) = “All Queues” Then
‘ Unhide the columns if they are hidden
If cell.Columns.Hidden Then
cell.Columns.Hidden = False
End If
‘ Select the first cell of the unhidden merged area
cell.Cells(1, 1).Select
queueFound = True
Else
‘ Hide the columns if they are not the selected queue
cell.Columns.Hidden = True
End If
End If
Else
‘ If the column is blank, hide it
ws.Columns(col).Hidden = True
End If
Next col
‘ If “All Queues” is selected, show all queues data
If selectedQueue = “All Queues” Then
For col = 7 To 104
ws.Columns(col).Hidden = False
Next col
queueFound = True
End If
‘ If the queue is not found, show a message
If Not queueFound Then
MsgBox “Queue not found in row 5.”
End If
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
MsgBox “An error occurred: ” & Err.Description
Application.ScreenUpdating = True
End If
‘ Handle status changes and timestamping
If Not Intersect(Target, Range(“G6:G1000”)) Is Nothing Then
If Not IsEmpty(Target) Then
‘ Define headers and their corresponding columns
Dim headers As Variant
headers = Array(“Status”, “Commence”, “Awaiting”, “Re-Picked”, “Completed”)
Dim headerCol As Integer
Dim statusCol As Integer
Dim timestampCol As Integer
‘ Find the header columns
For i = LBound(headers) To UBound(headers)
headerCol = Application.Match(headers(i), ws.Rows(6), 0)
If headers(i) = “Status” Then statusCol = headerCol
If Target.Column = statusCol Then
‘ Get corresponding timestamp column
Select Case Target.Value
Case “Commence”
timestampCol = Application.Match(“Commence”, ws.Rows(6), 0)
Case “Awaiting”
timestampCol = Application.Match(“Awaiting”, ws.Rows(6), 0)
Case “Re-Picked”
timestampCol = Application.Match(“Re-Picked”, ws.Rows(6), 0)
Case “Completed”
timestampCol = Application.Match(“Completed”, ws.Rows(6), 0)
End Select
‘ Insert timestamp
If timestampCol > 0 Then
ws.Cells(Target.Row, timestampCol).Value = Now
End If
End If
Next i
End If
End If
End Sub
Need to find errors in this excel VBA Code Private Sub Worksheet_Change(ByVal Target As Range)Dim ws As WorksheetSet ws = MeDim selectedQueue As StringDim col As IntegerDim cell As RangeDim queueFound As BooleanDim i As Long’ Handle queue selection in cell A1If Not Intersect(Target, Range(“A1”)) Is Nothing ThenselectedQueue = ws.Range(“A1”).ValuequeueFound = False’ Unhide/hide columns based on queue selectionOn Error GoTo ErrorHandlerApplication.ScreenUpdating = False’ Loop through columns G to CZFor col = 7 To 104If ws.Cells(5, col).MergeCells ThenSet cell = ws.Cells(5, col).MergeAreaIf Not IsError(cell.Cells(1, 1).Value) And Not IsEmpty(cell.Cells(1, 1).Value) ThenIf Trim(CStr(cell.Cells(1, 1).Value)) = Trim(selectedQueue) Or Trim(selectedQueue) = “All Queues” Then’ Unhide the columns if they are hiddenIf cell.Columns.Hidden Thencell.Columns.Hidden = FalseEnd If’ Select the first cell of the unhidden merged areacell.Cells(1, 1).SelectqueueFound = TrueElse’ Hide the columns if they are not the selected queuecell.Columns.Hidden = TrueEnd IfEnd IfElse’ If the column is blank, hide itws.Columns(col).Hidden = TrueEnd IfNext col’ If “All Queues” is selected, show all queues dataIf selectedQueue = “All Queues” ThenFor col = 7 To 104ws.Columns(col).Hidden = FalseNext colqueueFound = TrueEnd If’ If the queue is not found, show a messageIf Not queueFound ThenMsgBox “Queue not found in row 5.”End IfApplication.ScreenUpdating = TrueExit SubErrorHandler:MsgBox “An error occurred: ” & Err.DescriptionApplication.ScreenUpdating = TrueEnd If’ Handle status changes and timestampingIf Not Intersect(Target, Range(“G6:G1000”)) Is Nothing ThenIf Not IsEmpty(Target) Then’ Define headers and their corresponding columnsDim headers As Variantheaders = Array(“Status”, “Commence”, “Awaiting”, “Re-Picked”, “Completed”)Dim headerCol As IntegerDim statusCol As IntegerDim timestampCol As Integer’ Find the header columnsFor i = LBound(headers) To UBound(headers)headerCol = Application.Match(headers(i), ws.Rows(6), 0)If headers(i) = “Status” Then statusCol = headerColIf Target.Column = statusCol Then’ Get corresponding timestamp columnSelect Case Target.ValueCase “Commence”timestampCol = Application.Match(“Commence”, ws.Rows(6), 0)Case “Awaiting”timestampCol = Application.Match(“Awaiting”, ws.Rows(6), 0)Case “Re-Picked”timestampCol = Application.Match(“Re-Picked”, ws.Rows(6), 0)Case “Completed”timestampCol = Application.Match(“Completed”, ws.Rows(6), 0)End Select’ Insert timestampIf timestampCol > 0 Thenws.Cells(Target.Row, timestampCol).Value = NowEnd IfEnd IfNext iEnd IfEnd IfEnd Sub Read More