Home > Net >  Why does my macro for the dropdownlists only work sometimes?
Why does my macro for the dropdownlists only work sometimes?

Time:01-06

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
  •  Tags:  
  • Related