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

 

[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

 

[I_know_nuffin]

your code to see if it has reached the end and then exit the loop

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

this is checked after you reload foundcell so it would never add this data if it is the last cell

 

[philbass1978]

thanks for the reply...I added the following code to try and overcome this:
' Check if the loop has completed a full cycle and returned to the first found cell
If Not foundCell Is Nothing And foundCell.Address = firstFoundCell.Address Then
Exit Do ' Exit the loop if it has completed a full cycle
End If

But I am still getting the same results and error about mismatch?

 

[Joe4]

When you get the error, do you have a option button for "Debug"?
If you click that "Debug" button, which line of code does it highlight?

 

[philbass1978]

It does have debug but when I select it it doesn't highlight any specific line which is far from helpful

 

[I_know_nuffin]

all you needed to do was move the

Set foundCell = wsWestbound.Range("C5:BD289").FindNext(foundCell)

to below the check so it loads after the check

 

[philbass1978]

all you needed to do was move the

Set foundCell = wsWestbound.Range("C5:BD289").FindNext(foundCell)

to below the check so it loads after the check

Tried that but then only get the first instance of each time...I need to get every instance of the time value (hence stumped)

 

[I_know_nuffin]

I've just run your code with limited colums /rows and with the check code removed and it loops through all rows columns

 

[philbass1978]

I've just run your code with limited colums /rows and with the check code removed and it loops through all rows columns

The problem is that it is looking for multiple occasions of the same time value to then return multiple values.
Are you abel to provide an example of how you have got it working as I think I've just hit a proverbial "brick wall"