CarolineGMartin90
New Member
Hi there,
Have been struggling with this code for a while now and hoping someone could shed some light on where I am going wrong!
Summary of sheet: user scans a barcode into column A - based on this code ("N000002342" e.g.), column L populates (via manual Vlookup function I have in place) with another Code (e.g. "T1.1001, T1.2001, T1.3001, N0001" etc.). This code denotes a shift pattern worked by the user - .1 = 08:00-16:00 shift, .2 = 10:00-18:00 shift, .3 = 12:00 - 20:00 shift and N = night shift. What I want in column N is to enter the shift pattern based on the code populated into column L. The codes I have in place work, as tested on a seperate work book. The issue arises with running the final bit of code (extrapolating the shift pattern into column N) alongside the existing code.
Below is the code I have on one sheet - my issue is with getting the final bit of code to work along side the other ones. At the moment as it stands, the final bit (where the shift pattern i.e. "08:00-16:00", is entered into column N based on the code entered into column L via manual V-lookup) works in terms of populating the shift pattern, however it then enters an indefinite loop. I think it has something to do with enable events - however when I disable them at the start of this particular bit of code, it then stops all my code prior to it from working also
Any advice greatly appreciated!
Have been struggling with this code for a while now and hoping someone could shed some light on where I am going wrong!
Summary of sheet: user scans a barcode into column A - based on this code ("N000002342" e.g.), column L populates (via manual Vlookup function I have in place) with another Code (e.g. "T1.1001, T1.2001, T1.3001, N0001" etc.). This code denotes a shift pattern worked by the user - .1 = 08:00-16:00 shift, .2 = 10:00-18:00 shift, .3 = 12:00 - 20:00 shift and N = night shift. What I want in column N is to enter the shift pattern based on the code populated into column L. The codes I have in place work, as tested on a seperate work book. The issue arises with running the final bit of code (extrapolating the shift pattern into column N) alongside the existing code.
Below is the code I have on one sheet - my issue is with getting the final bit of code to work along side the other ones. At the moment as it stands, the final bit (where the shift pattern i.e. "08:00-16:00", is entered into column N based on the code entered into column L via manual V-lookup) works in terms of populating the shift pattern, however it then enters an indefinite loop. I think it has something to do with enable events - however when I disable them at the start of this particular bit of code, it then stops all my code prior to it from working also
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_ChangeA Target
Worksheet_ChangeB Target
Worksheet_SelectionChangeC Target
End Sub
Private Sub Worksheet_ChangeA(ByVal Target As Range)
Dim A As Range, B As Range, Inte As Range, n As Range, H As Range
Dim R As Long
If Target.Row > 1 And Target.Column = 5 And Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
' Search Down
If Target.Offset(1, -2).Value <> "" Then
R = Target.Offset(0, -2).End(xlDown).Row
If Cells(R, 3).Value & Cells(R, 5).Value = Target.Offset(0, -2).Value & Target.Value Then
MsgBox ("Duplicate 'Fault Category' already inputted, relating to this set, in the row below." & vbCrLf & vbCrLf & "Please ensure you mention all the respective instruments, if they have the same 'Fault Category', in the 'Instrument Requiring Rewash / Issue' box - (One row DOWN & two boxes to the left)." & vbCrLf & vbCrLf & "Do NOT separate the instruments into individual rows if they have the same respective 'Fault Category', and relate to the same set.")
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True
End If
R = R - 1
End If
' Search Up R = 1
If Target.Offset(-R, -2).Value & Target.Offset(-R, 0).Value = Target.Offset(0, -2).Value & Target.Value Then
MsgBox ("Duplicate 'Fault Category' already inputted, relating to this set, on the row above." & vbCrLf & vbCrLf & "Please ensure you mention all the respective instruments, if they have the same 'Fault Category', in the 'Instrument Requiring Rewash / Issue' box - (One row UP & two boxes to the left)." & vbCrLf & vbCrLf & "Do NOT separate the instruments into individual rows if they have the same respective 'Fault Category', and relate to the same set.")
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True
End If
R = R + 1
End If
Set A = Range("A:A")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each n In Inte
n.Offset(0, 9).Value = Date
n.Offset(0, 10).Value = Time
Next n
Application.EnableEvents = True
End Sub
Private Sub Worksheet_ChangeB(ByVal Target As Range)
If Target.Column = 8 And Target <> "" Then
If Cells(Target.Row, Target.Column - 1).Value = "" Then
Target.Value = ""
MsgBox "Washer must be entered before scanning Supervisor"
Exit Sub
End If
End If
End Sub
Private Sub Worksheet_SelectionChangeC(ByVal Target As Range) ' *ISSUE HERE*
Dim rng As Range, cell As Range
Set rng = Sheets(1).Range("L4:L500")
For Each cell In rng
If IsError(cell.Value) Then
Exit Sub
Else
If InStr(1, cell, ".1", 1) Then
cell.Offset(0, 2) = "08:00 - 16:00"
Else
If InStr(1, cell, ".2", 1) Then
cell.Offset(0, 2) = "10:00 - 18:00"
Else
If InStr(1, cell, ".3", 1) Then
cell.Offset(0, 2) = "12:00 - 20:00"
Else
If InStr(1, cell, "N", 1) Then
cell.Offset(0, 2) = "Night Shift"
End If
End If
End If
End If
End If
Next
End Sub
Any advice greatly appreciated!
Last edited by a moderator: