ammx
10-11-2006, 07:11 AM
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
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