Creating a Train Time Table

[philbass1978]

Hi there,
I am trying to create an excel spreadsheet that will check a train timetable for a given number of values and tell me where certain trains are located.

I have created an excel document which has the following sheets in it (CodeTest, TrainResults, Westbound).

I have written a macro that searches for a set of given times found on the CodeTest sheet in range D9 onwards and looks on the Westbound (only doing one line until I get this right) sheet for the matching time value. When it finds the matching time value which there are multiples over within my data range. It returns the values for the trains headcode (located in row 2 of the Westbound sheet) with its corresponding location (found in column A of the Westbound sheet). This data is then put into the TrainResults sheet for each match found.

The problem I have is that not all data is being returned, in the example I have used I received 20 out of 21 matches (21 matches were confirmed by the excel find functionality)...I also receive a "Run-Time error '13': Type Mismatch" which I think is due to defining my search value as a Date - I have tried changing this to Variable but if I do it doesnt return any values.

I have attached screenshots of the excel file and the Vba code is below in the hope that someone can point me in the right direction as I am stumped.

Sub GenerateSearchResults()
   Dim wb As Workbook
   Dim wsCodeTest As Worksheet
   Dim wsWestbound As Worksheet
   Dim wsResults As Worksheet
   Dim searchValues As Range
   Dim resultRow As Long
   Dim cell As Range
   Dim searchValue As Date
   Dim foundCell As Range
   Dim headCode As String
   Dim location As String

   ' Set the workbook and worksheet objects
   Set wb = ThisWorkbook
   Set wsCodeTest = wb.Sheets("CodeTest")
   Set wsWestbound = wb.Sheets("Westbound")
'  Set wsResults = wb.Sheets.Add(After:=wsCodeTest) ' Create a new sheet for results
   Set wsResults = wb.Sheets("TrainResults") ' Sheet for results
   ' Set the range of search values in column D of the "CodeTest" sheet
   Set searchValues = wsCodeTest.Range("D9:D200")
   ' Set the initial row for displaying search results on the "Results" sheet
   resultRow = 2
   ' Loop through each search value
   For Each cell In searchValues
       searchValue = cell.Value
       ' Find the first occurrence of the time value on the "Westbound" sheet
       Set foundCell = wsWestbound.Range("C5:BD289").Find(What:=CStr(searchValue), LookIn:=xlValues, LookAt:=xlWhole)
       ' Check if any matching cell is found
       If Not foundCell Is Nothing Then
           Do
               ' Get the head code and location from the corresponding row 2 and column A on the "Westbound" sheet
               headCode = wsWestbound.Cells(2, foundCell.Column).Value
               location = wsWestbound.Cells(foundCell.Row, 1).Value
               ' Write the search value, head code, and location to the "Results" sheet
               wsResults.Cells(resultRow, 1).Value = Format(searchValue, "hh:mm:ss")
               wsResults.Cells(resultRow, 2).Value = headCode
               wsResults.Cells(resultRow, 3).Value = location
               'wsResults.Cells(resultRow, 4).Value = foundCell.Value
               'wsResults.Cells(resultRow, 5).Value = foundCell.Address
               resultRow = resultRow + 1
               ' Find the next occurrence of the time value
               Set foundCell = wsWestbound.Range("C5:BD289").FindNext(foundCell)
               ' Check if the loop has completed a full cycle and returned to the first found cell
               If foundCell.Address = wsWestbound.Range("C5:BD289").Find(What:=CStr(searchValue), LookIn:=xlValues, LookAt:=xlWhole).Address Then
                   Exit Do ' Exit the loop if it has completed a full cycle
               End If
           Loop Until foundCell Is Nothing
       Else
           ' Write "Not Found" if the search value is not found
           wsResults.Cells(resultRow, 1).Value = Format(searchValue, "hh:mm:ss")
           wsResults.Cells(resultRow, 2).Value = "Not Found"
           wsResults.Cells(resultRow, 3).Value = "Not Found"
           'wsResults.Cells(resultRow, 4).Value = "Not Found"
           'wsResults.Cells(resultRow, 5).Value = "Not Found"
           resultRow = resultRow + 1
       End If
   Next cell
   'Rename results sheet
   'wsResults.Name = "TrainResults"
   ' Autofit columns on the "Results" sheet
   wsResults.Columns.AutoFit
End Sub

 

[philbass1978]

try the below

its a bit rough so will need tidying but it seems to work and matches te output expected as above for 06:31:00

Sub findtimes()

Dim wb As Workbook
   Dim wsCodeTest As Worksheet
   Dim wsWestbound As Worksheet
   Dim wsResults As Worksheet
   Dim searchValues As Range
   Dim resultRow As Long
   Dim cell As Range
   Dim searchValue As Date
   Dim foundCell As Range
   Dim headCode As String
   Dim location As String
   Dim firstaddress As String
   Dim newvalue As Double
   Dim searchdate As Date
  
   'On Error GoTo error:

   ' Set the workbook and worksheet objects
   Set wb = ThisWorkbook
   Set wsCodeTest = wb.Sheets("CodeTest")
   Set wsWestbound = wb.Sheets("Westbound")
'  Set wsResults = wb.Sheets.Add(After:=wsCodeTest) ' Create a new sheet for results
   Set wsResults = wb.Sheets("TrainResults") ' Sheet for results
  
  
   Set searchValues = wsCodeTest.Range("D9:D200")
   Set srchrng = wsWestbound.Range("C5:HB289")

   ' Set the initial row for displaying search results on the "Results" sheet
   resultRow = 2

   ' Loop through each search value
   For Each cell In searchValues
   If cell.Value = "" Then Exit For
   newvalue = cell.Value
   'searchValue = cell.Value
   'searchdate = cell.Value

        For Each c In srchrng
        'Debug.Print c.Value, c.Address
        If c.Value = newvalue Then
        'Stop
               headCode = wsWestbound.Cells(2, c.Column).Value
               location = wsWestbound.Cells(c.Row, 1).Value

               ' Write the search value, head code, and location to the "Results" sheet
               wsResults.Cells(resultRow, 1).Value = Format(newvalue, "hh:mm:ss")
               wsResults.Cells(resultRow, 2).Value = headCode
               wsResults.Cells(resultRow, 3).Value = location
               'wsResults.Cells(resultRow, 4).Value = c.Value
               'wsResults.Cells(resultRow, 5).Value = c.Address
               resultRow = resultRow + 1
       
        End If
        Next

   Next 'cell

End Sub

That's a really big step forward...thank you.

I have tried adding in some more times and unfortunately not all results were returned.
The following times return exactly the right data: 06:31:00 & 06:31:05.
However any time after that, so the 3rd iteration onwards 1 value is missing.

Here are the required values:
06:31:00 - 9V12(NA), 9V11(TS17W), 9V10(TS10W_11W), 9V09(TS07W_1), 9V08(TS03W_2)
06:31:05 - 9V11(TS17W), 9V10(TS10W_11W), 9V09(TS07W_1), 9V08(TS03W_2)
06:31:10 - 9V11(TS16W_17W), 9V10(TS10W), 9V09(TS07W_1), 9V08(TS03W_2)
06:31:15 - 9V11(TS16W_17W), 9V10(TS10W), 9V09(TS07W_1), 9V08(TS03W_2)
06:31:20 - 9V11(TS16W_17W), 9V10(TS10W), 9V09(TS07W_1), 9V08(TS03W_1)

These are the current returned values:

06:31:00​	9V12	N_A
06:31:00​	9V11	TS17W
06:31:00​	9V10	TS10W_11W
06:31:00​	9V09	TS07W_1
06:31:00​	9V08	TS03W_2
06:31:05​	9V11	TS17W
06:31:05​	9V10	TS10W_11W
06:31:05​	9V09	TS07W_1
06:31:05​	9V08	TS03W_2
06:31:10​	9V11	TS16W_17W
06:31:10​	9V09	TS07W_1
06:31:10​	9V08	TS03W_2
06:31:15​	9V11	TS16W_17W
06:31:15​	9V09	TS07W_1
06:31:15​	9V08	TS03W_2
06:31:20​	9V11	TS16W_17W
06:31:20​	9V09	TS07W_1
06:31:15​	9V09	TS07W_1
06:31:15​	9V08	TS03W_2
06:31:15​	9V11	TS16W_17W
06:31:20​	9V13	TS16W_2
06:31:20​	9V10	TS10W
06:31:20​	9V09	TS07W_1
06:31:20​	9V08	TS03W_1
06:31:20​	9V11	TS16W_17W

We're almost there...thanks again for all your help thus far

 

[I_know_nuffin]

its because the contents aren't the same for 06:31:10
K150 is missing and its 1 digit out

0.2716435185185180000000000	L90
0.2716435185185190000000000	K150

 

[philbass1978]

its because the contents aren't the same for 06:31:10
K150 is missing and its 1 digit out

0.2716435185185180000000000	L90
0.2716435185185190000000000	K150

Wow, I didn't even notice that as I have the cells formatted for time (hh:mm:ss) and I suppose we wouldn't see that kind of discrepancy. I will try and correct each cell and see what happens.

Thanks for your persistance

 

[I_know_nuffin]

in your main routine

update

For Each cell In searchValues
   If cell.Value = "" Then Exit For
   newvalue = cell.Value

to

For Each cell In searchValues
   If cell.Value = "" Then Exit For
   newvalue = round(cell.Value,6)

so this then matches the format in the westbound sheet


use the below to update your westbound times

i would make a copy first

change the sheet name here :- Set ws1 = Sheets("Copyvalues")

Sub upddata()

Dim rng1 As Range
Dim rng2 As Range
Dim ws1 As Worksheet
Dim cell As Range
Dim str As String

Application.ScreenUpdating = False
Set ws1 = Sheets("Copyvalues")
Set rng1 = ws1.Range("C3")
Debug.Print rng1.Address
Set rng2 = ws1.Range("C3:HB294")
For Each cell In rng2
If Left(cell.Value, 1) = 0 Then
cell.Value = Round(cell.Value, 6)
cell.NumberFormat = "hh:mm:ss"
End If
Next
Application.ScreenUpdating = True
End Sub

 

[philbass1978]

in your main routine

update

For Each cell In searchValues
   If cell.Value = "" Then Exit For
   newvalue = cell.Value

to

For Each cell In searchValues
   If cell.Value = "" Then Exit For
   newvalue = round(cell.Value,6)

so this then matches the format in the westbound sheet


use the below to update your westbound times

i would make a copy first

change the sheet name here :- Set ws1 = Sheets("Copyvalues")

Sub upddata()

Dim rng1 As Range
Dim rng2 As Range
Dim ws1 As Worksheet
Dim cell As Range
Dim str As String

Application.ScreenUpdating = False
Set ws1 = Sheets("Copyvalues")
Set rng1 = ws1.Range("C3")
Debug.Print rng1.Address
Set rng2 = ws1.Range("C3:HB294")
For Each cell In rng2
If Left(cell.Value, 1) = 0 Then
cell.Value = Round(cell.Value, 6)
cell.NumberFormat = "hh:mm:ss"
End If
Next
Application.ScreenUpdating = True
End Sub

Thanks again for all your help.

I tried the changed code and it resulted in no results at all (stumped).

I reverted the code back and when I searched for the 06:31:10 time I found 4 results but yet when I ran the macro it returned only 3 results.

I have checked the values for the cells and there are no discrepancies in terms of values (I've attached screenshots of the values).

The other thing is that when I looked at more times there appears to be more trains missing so when 5 times where searched for the first two results were perfect but the 3rd was missing one, the 4th missing one and the 5th missing two results. I don't know why this would do this..is it getting lost in the loops somewhere?

Again, any help would be awesome.

 

[I_know_nuffin]

did you run the routine upddata() to reset your westbound times to 6 decimal places?

 

[philbass1978]

did you run the routine upddata() to reset your westbound times to 6 decimal places?

I hadn't but I just ran the upddata() and I got the following error "Run-time error '9': Subscript out of range"

 

[I_know_nuffin]

did you change copyvalues to the correct worksheet name?

Set ws1 = Sheets("Copyvalues")

 

[philbass1978]

did you change copyvalues to the correct worksheet name?

Set ws1 = Sheets("Copyvalues")

I changed the name of the Sheet to "Westbound" and it all appears to be working now...thanks...my own stupidity in not following instructions.

Thanks for all your help.

 

[I_know_nuffin]

Glad I could help