I made a macro that let's the user use a dropdownlist (e.g. 1,2,3) and everytime a value is selected a formatted overview is shown in the cell with the dropdownlist (e.g. 2 - 1 - 3). I did this for two different dropdownlist. When I opened it this morning the macro didn't work anymore and kept showing the current selected values but forgot the old values. It seems to works sometimes and sometimes it doesn't. Could anyone tell me where I went wrong?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'Declaration of the var
Dim Oldvalue As String
Dim Newvalue As String
Dim OldvalueTPR As String
Dim NewvalueTPR As String
Application.EnableEvents = True
On Error GoTo Exitsub
'first dropdown
If Target.Address = "$B$199" Or Target.Address = "$B$200" Or Target.Address = "$B$201" Or Target.Address = "$B$202" _
Or Target.Address = "$B$203" Or Target.Address = "$B$204" Or Target.Address = "$B$205" Or Target.Address = "$B$206" _
Or Target.Address = "$B$207" Or Target.Address = "$B$208" Or Target.Address = "$B$209" Or Target.Address = "$B$210" _
Or Target.Address = "$B$211" Or Target.Address = "$B$212" Or Target.Address = "$B$213" Or Target.Address = "$B$214" _
Or Target.Address = "$B$215" Or Target.Address = "$B$216" Or Target.Address = "$B$217" Or Target.Address = "$B$218" _
Or Target.Address = "$B$223" Or Target.Address = "$B$224" Or Target.Address = "$B$225" Or Target.Address = "$B$226" _
Or Target.Address = "$B$227" Or Target.Address = "$B$228" Or Target.Address = "$B$229" Or Target.Address = "$B$230" _
Or Target.Address = "$B$231" Or Target.Address = "$B$232" Or Target.Address = "$B$233" Or Target.Address = "$B$234" _
Or Target.Address = "$B$235" Or Target.Address = "$B$236" Or Target.Address = "$B$237" Or Target.Address = "$B$238" _
Or Target.Address = "$B$239" Or Target.Address = "$B$240" Or Target.Address = "$B$241" Or Target.Address = "$B$242" _
Or Target.Address = "$B$243" _
Or Target.Address = "$B$247" Or Target.Address = "$B$248" Or Target.Address = "$B$249" Or Target.Address = "$B$250" _
Or Target.Address = "$B$251" Or Target.Address = "$B$252" Or Target.Address = "$B$253" Or Target.Address = "$B$254" _
Or Target.Address = "$B$255" Or Target.Address = "$B$256" Or Target.Address = "$B$257" Or Target.Address = "$B$258" _
Or Target.Address = "$B$259" Or Target.Address = "$B$260" Or Target.Address = "$B$261" _
Or Target.Address = "$B$266" Or Target.Address = "$B$267" Or Target.Address = "$B$268" Or Target.Address = "$B$269" _
Or Target.Address = "$B$270" Or Target.Address = "$B$271" Or Target.Address = "$B$272" Or Target.Address = "$B$273" _
Or Target.Address = "$B$274" Or Target.Address = "$B$275" _
Or Target.Address = "$F$120" 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
'Second dropdown different format
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "$C$199" Or Target.Address = "$C$200" Or Target.Address = "$C$201" Or Target.Address = "$C$202" _
Or Target.Address = "$C$203" Or Target.Address = "$C$204" Or Target.Address = "$C$205" Or Target.Address = "$C$206" _
Or Target.Address = "$C$207" Or Target.Address = "$C$208" Or Target.Address = "$C$209" Or Target.Address = "$C$210" _
Or Target.Address = "$C$211" Or Target.Address = "$C$212" Or Target.Address = "$C$213" Or Target.Address = "$C$214" _
Or Target.Address = "$C$215" Or Target.Address = "$C$216" Or Target.Address = "$C$217" Or Target.Address = "$C$218" _
Or Target.Address = "$C$223" Or Target.Address = "$C$224" Or Target.Address = "$C$225" Or Target.Address = "$C$226" _
Or Target.Address = "$C$227" Or Target.Address = "$C$228" Or Target.Address = "$C$229" Or Target.Address = "$C$230" _
Or Target.Address = "$C$231" Or Target.Address = "$C$232" Or Target.Address = "$C$233" Or Target.Address = "$C$234" _
Or Target.Address = "$C$235" Or Target.Address = "$C$236" Or Target.Address = "$C$237" Or Target.Address = "$C$238" _
Or Target.Address = "$C$239" Or Target.Address = "$C$240" Or Target.Address = "$C$241" Or Target.Address = "$C$242" _
Or Target.Address = "$C$243" _
Or Target.Address = "$C$247" Or Target.Address = "$C$248" Or Target.Address = "$C$249" Or Target.Address = "$C$250" _
Or Target.Address = "$C$251" Or Target.Address = "$C$252" Or Target.Address = "$C$253" Or Target.Address = "$C$254" _
Or Target.Address = "$C$255" Or Target.Address = "$C$256" Or Target.Address = "$C$257" Or Target.Address = "$C$258" _
Or Target.Address = "$C$259" Or Target.Address = "$C$260" Or Target.Address = "$C$261" _
Or Target.Address = "$C$266" Or Target.Address = "$C$267" Or Target.Address = "$C$268" Or Target.Address = "$C$269" _
Or Target.Address = "$C$270" Or Target.Address = "$C$271" Or Target.Address = "$C$272" Or Target.Address = "$C$273" _
Or Target.Address = "$C$274" Or Target.Address = "$C$275" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
NewvalueTPR = Target.Value
Application.Undo
OldvalueTPR = Target.Value
If OldvalueTPR = "" Then
Target.Value = NewvalueTPR
Else
If InStr(1, OldvalueTRP, NewvalueTPR) = 0 Then
Target.Value = OldvalueTPR & vbNewLine & NewvalueTPR
Else:
Target.Value = OldvalueTPR
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
End Sub
CodePudding user response:
Try
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
On Error Resume Next
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
Exit Sub
End If
On Error GoTo 0
Dim oldvalue, newvalue, sep As String
Dim rng1 As Range, rng2 As Range
Set rng1 = Range("B199:B218,B223:B243,B247:B261,B266:B275,F120")
Set rng2 = Range("C199:C218,C223:C243,C247:C261,C266:C275")
If Not Application.Intersect(Target, rng1) Is Nothing Then
sep = " - "
ElseIf Not Application.Intersect(Target, rng2) Is Nothing Then
sep = vbNewLine
Else
Exit Sub
End If
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 & sep & newvalue
Else
Target.Value = oldvalue
End If
End If
Application.EnableEvents = True
End Sub
