Funktion nur einmal aufrufen
08.08.2019 11:03:01
Marvin
ich habe mal wieder ein Problem....
In dem unten stehenden Code, generiere ich eine Drop Down Liste aus einem Array. Ich möchte diese Generierung als Funktion schreiben und dann über ein SelectionChange aufrufen. Allerdings habe ich das Problem, dass die Drop Down Liste immer wieder neu aufgebaut wird und sich dann bestimmte Werte wiederholen. Das möchte ich aber nicht.
Sobald ein Name gewählt wurde und ich in einer andere Zelle wechsele, möchte ich nur noch die übrig gebliebenen angezeigt bekommen.
Hier ist mein Code zum Generierung des Arrays: Dabei werden die Namen der einzelne Sheets mit Namen aus einer bestimmten Zelle im jeweiligen Sheet verglichen. Alle die übereinstimmen werden im Array zusammen geführt und auf den Status False(nicht gewählt) gesetzt. Zudem wird am Anfang überprüft ob einer der Namen schon in der Drop Down Liste steht, sodass dieser nicht mit aufgenommen wird.
Sub Workbook_Open()
Dim Sheetname As String
Dim Cellname As String
Dim i As Long, j As Long
Dim Compare As Long
Dim raListe As Range
With Worksheets("menu")
If .Range("B5") = "" Then
Set raListe = .Range("cRstart")
Else
Set raListe = .Range("B" & cRStart & " :B" & cREnd)
End If
End With
'Compare Name from all Worksheets with Cellname in defined Cell'
For i = 1 To ThisWorkbook.Worksheets.Count
Sheetname = Sheets(i).Name
Cellname = Sheets(i).Range("D2")
Compare = InStr(1, Cellname, Sheetname, vbTextCompare)
'All Names from Worksheets which are like the Name in the defined Cell are listed in _
array wsName()'
If Compare > 0 Then
If WorksheetFunction.CountIf(raListe, Sheetname) = 0 Then
j = j + 1
ReDim Preserve WSArray(1 To j)
With WSArray(j)
.Name = Sheets(i).Name
.Status = False
End With
End If
End If
Next i
End Sub Hier wird meine Drop Down Liste aufgebaut. Der Bereich der mit # gekennzeichnet ist, möchte ich als function aufrufen.
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim DDName As String
Dim j As Integer
'Define the Range where u can choose the Projects with the DropDown Menu'
If Not Intersect(target, Range("B" & cRStart & " :B" & cREnd)) Is Nothing Then
'Set the Public Variable str0ldProject as empty and Proof if the Selected Cell is empty too.
'If not then str0ldProject is the Value from the Selected Cell. Len function counts _
all numbers from the String
Application.ScreenUpdating = False
strOldProject = ""
If Len(target.Value) > 0 Then strOldProject = target.Value
'Loop to Define the array as a String for the DropDown Menu'
For j = LBound(WSArray) To UBound(WSArray)
If WSArray(j).Status = False Then
DDName = DDName & WSArray(j).Name & ","
End If
Next j
DDName = Left$(DDName, Len(DDName) - 1)
'Generate DropDownMenu in the Cell which is in the Range'
With ActiveCell
.Validation.Delete
.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlGreater, Formula1:=DDName
.Validation.IgnoreBlank = True
.Validation.InCellDropdown = True
.Validation.ShowInput = True
End With
'############################################################################################### _
Application.ScreenUpdating = True
End If
End Sub