isaacslowe
New Member
- Joined
- May 3, 2020
- Messages
- 1
- Office Version
- 365
- Platform
- Windows
- MacOS
Hi, I'm trying to make a database with both an auto-updating change log and one with the ability for multi select drop-down lists. I can currently get one or the other working but not both at the same time. I was wondering if this was possible at all. Heres the code that I'm using:
Private Sub Worksheet_Change(ByVal Target As Range)
'Auto change log
If Not Intersect(Target, Range("A1:BQ235")) Is Nothing Then
If Target.Count > 1 Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End
End If
If ActiveSheet.Name = "Infobase" Then
Range("A250").Value = Target.Address
AddToLog
End If
End If
'Multi-select drop-downs
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = "3" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & ", " & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Auto change log
If Not Intersect(Target, Range("A1:BQ235")) Is Nothing Then
Range("A251").Value = Target.Value 'Was B4
Range("A252").Value = Target.Row 'Was B3
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Auto change log
If Not Intersect(Target, Range("A1:BQ235")) Is Nothing Then
If Target.Count > 1 Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End
End If
If ActiveSheet.Name = "Infobase" Then
Range("A250").Value = Target.Address
AddToLog
End If
End If
'Multi-select drop-downs
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = "3" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & ", " & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Auto change log
If Not Intersect(Target, Range("A1:BQ235")) Is Nothing Then
Range("A251").Value = Target.Value 'Was B4
Range("A252").Value = Target.Row 'Was B3
End If
End Sub