2 VBA Befehle in einem Worksheet
Reinhardt
ich habe ein (hoffentlich) einfaches Problem:
Ich habe eine VBA Code, der mir bestimmte Werte anzeigt, Name: Gültigkeitsliste / Filterdropdown
sitzt in "Q5".
Nun soll im selben Tabellenblatt ein zweiter Filter reingesetzt werden (Zelle "S5"), der zusätzlich nach einem andere Kriterium filtern soll. Ich habe dazu naiverweise einfach den funktionierenden VBA Code nochmals kopiert und die Zellenbezüge geändert und alle Namen um eine 1 ergänzt...
Nun meckert Excel, unter dem "end sub" darf kein weiter VBA code stehen...
Aber das war wohl zu einfach gedacht?..könnt Ihr mir weiterhelfen?
Danke im Voraus!
Reini
Option Explicit
Private Sub Gueltigkeitsliste()
Dim Dic As Object
Dim strFilterText As String
Dim Arr
Dim L As Long
Set Dic = CreateObject("Scripting.Dictionary")
Arr = Range("C35", Cells(Rows.Count, 3).End(xlUp))
Dic("") = 0
For L = 1 To UBound(Arr)
If Not IsError(Arr(L, 1)) Then
If Arr(L, 1) "" Then
Dic(Arr(L, 1)) = 0
End If
End If
Next
strFilterText = Join(Dic.keys, ",")
With Range("Q5").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=strFilterText
End With
End Sub
Private Sub Worksheet_Activate()
Call Gueltigkeitsliste
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rZelle As Range
With Application
.EnableEvents = False
For Each rZelle In Target
If rZelle.Address = "$Q$5" And rZelle.Cells.Count = 1 Then
If Target "" Then
Range("C35:C" & Cells.SpecialCells(xlCellTypeLastCell).Row).AutoFilter 1, Range("Q5" _
_
), , , False
Else
If ActiveSheet.FilterMode Then
Range("C35").AutoFilter
End If
End If
ElseIf Not Intersect(rZelle, Range("C35:C" & Cells.SpecialCells(xlCellTypeLastCell).Row)) _
_
Is Nothing Then
Call Gueltigkeitsliste
End If
Next rZelle
.EnableEvents = True
End With
End Sub
Private Sub Gueltigkeitsliste1()
Dim Dic As Object
Dim strFilterText As String
Dim Arr
Dim L As Long
Set Dic = CreateObject("Scripting.Dictionary")
Arr = Range("AC35", Cells(Rows.Count, 29).End(xlUp))
Dic("") = 0
For L = 1 To UBound(Arr)
If Not IsError(Arr(L, 1)) Then
If Arr(L, 1) "" Then
Dic(Arr(L, 1)) = 0
End If
End If
Next
strFilterText = Join(Dic.keys, ",")
With Range("S5").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=strFilterText
End With
End Sub
Private Sub Worksheet_Activate1()
Call Gueltigkeitsliste1
End Sub
Private Sub Worksheet_Change1(ByVal Target As Range)
Dim rZelle As Range
With Application
.EnableEvents = False
For Each rZelle In Target
If rZelle.Address = "$S$5" And rZelle.Cells.Count = 1 Then
If Target "" Then
Range("AC35:AC" & Cells.SpecialCells(xlCellTypeLastCell).Row).AutoFilter 1, Range(" _
_
S5"), , , False
Else
If ActiveSheet.FilterMode Then
Range("AC35").AutoFilter
End If
End If
ElseIf Not Intersect(rZelle, Range("AC35:C" & Cells.SpecialCells(xlCellTypeLastCell).Row)) _
_
Is Nothing Then
Call Gueltigkeitsliste1
End If
Next rZelle
.EnableEvents = True
End With
End Sub