check for unique entries in a string array

[ammx]

Hi,

I have a workbook that contains basically three types of work sheets:
1 * SUMMARY sheet
1 * TIMES sheet
x * 'station data entry' sheets.

The 'station data entry' sheets will always contain the value 'ANALYZING SHEET' in cell D2 (formula isStationSheet())

The sheetnames will follow a naming convention of 'stationID_option'.
Example:
In the sheet name '120_a', the station ID = 120, the option = a.
A typical list of sheet names would be (max. ~50 sheets):
100_a, 100_b, 100_e, 110_a, 110_b, 110_f, 120_a, ...
:think:
I copy the full station sheet names onto the summary sheet (e.g. 120_a) in a specific column (cSumStationRange = "A14:A100". This is working now.

But I also need to copy the unique station IDs (100,110,120) to the TIMES sheet into the cells cTIMStationRng (=d1:bz1).

Below is the SUB I could come up with so far. The problem is that I repeat the stationIDs when there are many options for the same sheet.
I.o.w in the example above my arStations contains 100,100,100,110,110,110,120, but I want it to contain 100,110,120.

I got stuck how to check if the stationID that I process in the ii-loop is already part of the arStation array:banghead: . I indicate the problematic lines with '???. Here I would need to check for duplicate entries, before I add the stationID to the array.

Btw. it does not need to be done with arrays. At the end I just need to have the unique stationsID copied to the TIMES sheet in a specific row.

Any help is highly appreciated:clap: ,

Michael

Public Sub UpdateStationLists()
Dim ii As Integer
Dim jj As Integer
Dim strStationID As String
Dim arStations() As String
Application.EnableEvents = False
'first clear any previous entries, simply up to
Worksheets("Summary").Range(cSUM_StationRng).ClearContents
Worksheets("Times").Range(cTIM_StationRng).ClearContents
'now feed Summary sheet with full stations names and array with unique station IDs
On Error GoTo Exit_sub:
jj = 0
For ii = 1 To Worksheets.Count
With Worksheets(ii)
' Check if the worksheet is a data entry sheet, if so add it's name to the summary sheet
' It is a data entry sheet if the cell D2 equals "ANALYZING SHEET"
If isStationSheet(.Name) Then
' Add full station sheet name (e.g. B120_c) to SUMMARY sheet, row by row
Worksheets("Summary").Range(cSUM_StationRng).Cells(1, 1).Offset(jj, 0) = .Name

' Fetch station name (e.g. B120) into arStations array
strStationID = getEntry(.Name, 1, "_")
' ???
' ???
' check if unique StationID exists in array already before adding it
' ???
' ???
ReDim Preserve arStations(jj)
arStations(jj) = strStationID
jj = jj + 1

End If
End With
Next ii

' Now process all station ID sheets found and store the stationID (e.g. B120) in the TIMES sheet
For jj = 0 To UBound(arStations())
' Add station sheet name to TIMES sheet, col by col
Worksheets("Times").Range(cTIM_StationRng).Cells(1, 1).Offset(0, jj) = arStations(jj)
Next jj

Exit_sub:
Application.EnableEvents = True
End Sub

Public Function getEntry(str, n, sepChar)
' Returns the nth element from a string,
' using a specified separator character
On Error GoTo ErrHandler
getEntry = Split(str, sepChar)(n - 1)
Exit Function
ErrHandler:
getEntry = ""
On Error GoTo 0
End Function

[mdmackillop]

Hi Michael
Welcome to VBAX
Can you post a sanitised extract from your workbook. Use Manage Attachments in the Go Advanced section.
Regards
MD

[acw]

Hi

Rather than using an array, try a collection. This will automatically only allow 1 entry for each item.

add a dim at the beginning



dim nodupes as new collection


Then replace the code


strStationID = getEntry(.Name, 1, "_")
' ???
' ???
' check if unique StationID exists in array already before adding it
' ???
' ???
ReDim Preserve arStations(jj)
arStations(jj) = strStationID
jj = jj + 1


with




strStationID = getEntry(.Name, 1, "_")
on error resume next 'to defeat the error message if adding an existing entry
nodupes.add item:=strStationID, key:=strStationID
on error goto 0 'turn error messaging back on



This will give you a unique list. To output you can do:



for i = 1 to nodupes.count
msgbox nodupes(i)
next i


HTH

Tony

[ammx]

Hi Tony,

sorry for the late response, but I'm back to the office just since a few minutes. Your simple code just works great.:thumb

Think, I have to explorer this 'collection' thing a bit more in the future. Never heard it...

Thanks very much and have a great day. :hi:

Michael