Forum Discussion
cherrypolisetti
Jul 19, 2024Copper Contributor
VBA
Sub Logout() Call Unprotect Range("O7").Select If ActiveCell = "" Then Exit Sub End If Call EndTimeNQ ' Log the logout details in the Report sheet Sheets("Report").Activate Sheets("Report"...
- Jul 19, 2024
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 On Error GoTo ErrorHandler ' 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 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 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 Variant 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 Not IsError(headerCol) Then 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 Not IsError(timestampCol) And timestampCol > 0 Then ws.Cells(Target.Row, timestampCol).Value = Now End If End If End If Next i End If End If Exit Sub ErrorHandler: MsgBox "An error occurred: " & Err.Description Application.ScreenUpdating = True End SubCorrected Code with Comments.
Placed On Error GoTo ErrorHandler at the beginning to cover the whole subroutine.
Added checks to ensure that Application.Match does not return an error before using the matched column.
My answers are voluntary and without guarantee!
Hope this will help you.
NikolinoDE
Jul 19, 2024Platinum Contributor
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
On Error GoTo ErrorHandler
' 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
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
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 Variant
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 Not IsError(headerCol) Then
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 Not IsError(timestampCol) And timestampCol > 0 Then
ws.Cells(Target.Row, timestampCol).Value = Now
End If
End If
End If
Next i
End If
End If
Exit Sub
ErrorHandler:
MsgBox "An error occurred: " & Err.Description
Application.ScreenUpdating = True
End SubCorrected Code with Comments.
Placed On Error GoTo ErrorHandler at the beginning to cover the whole subroutine.
Added checks to ensure that Application.Match does not return an error before using the matched column.
My answers are voluntary and without guarantee!
Hope this will help you.
- cherrypolisettiJul 20, 2024Copper ContributorThanks it worked good n also I've made few more changes