Option Explicit
Private Const wsBaseName As String = "Tabelle"
Private Const idBaseName As String = "ABC"
Public Function GetUniqueCustomerIdList() As Object
Dim wks As Excel.Worksheet
Dim rngData As Excel.Range
Dim rngCID As Excel.Range
Dim dic As Object
Dim n As Long
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = VbCompareMethod.vbTextCompare
For Each wks In Worksheets
If 0 = StrComp(Left$(wks.Name, Len(wsBaseName)), wsBaseName, vbTextCompare) Then
Set rngData = GetDataRange(Array("customer_id", "CID", "CUST_ID"), wks)
If rngData Is Nothing Then
Debug.Print "customer id column not found - worksheet: '"; wks.Name; "'"
Else
For Each rngCID In rngData.Cells
If Not dic.Exists(rngCID.Value) Then
n = n + 1
Debug.Print "adding ['"; CStr(rngCID.Value); "' := '"; idBaseName & n; "'] to list"
dic(rngCID.Value) = idBaseName & n
End If
Next
End If
End If
Next
Set GetUniqueCustomerIdList = dic
Set dic = Nothing
End Function
Private Function GetDataRange(ColumnNames As Variant, Worksheet As Excel.Worksheet) As Excel.Range
Dim rngCID As Excel.Range
Set rngCID = GetCell(ColumnNames, Worksheet)
If Not rngCID Is Nothing Then
Dim rngFirst As Excel.Range
Dim rngLast As Excel.Range
Set rngLast = Worksheet.Cells(Worksheet.Cells.Rows.Count, rngCID.Column).End(xlUp)
If rngCID.Offset(1).Value <> "" Then
Set rngFirst = rngCID.Offset(1)
Else
Set rngFirst = rngCID.End(xlDown)
End If
If rngFirst.Row <= rngLast.Row Then
Set GetDataRange = Worksheet.Range(rngFirst, rngLast)
End If
End If
End Function
Private Function GetCell(CellValue As Variant, Worksheet As Excel.Worksheet) As Excel.Range
If Worksheet Is Nothing Then Exit Function
Dim rngMatch As Excel.Range
Dim vntCells As Variant
Dim vntCell As Variant
If IsArray(CellValue) Then
vntCells = CellValue
Else
vntCells = Array(CellValue)
End If
For Each vntCell In vntCells
Set rngMatch = Worksheet.Cells.Find(vntCell, , xlValues, xlWhole, xlByRows, xlNext, False)
If Not rngMatch Is Nothing Then
Set GetCell = rngMatch
Exit Function
End If
Next
End Function