Creating a Train Time Table

philbass1978

New Member
Joined
Jun 23, 2023
Messages
14
Office Version
  1. 365
  2. 2011
Platform
  1. Windows
  2. MacOS
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.

VBA Code:
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
 

Attachments

  • CodeTest_sheet-min.jpg
    CodeTest_sheet-min.jpg
    151.9 KB · Views: 142
  • Empty_TrainResult sheet-min.jpg
    Empty_TrainResult sheet-min.jpg
    138.3 KB · Views: 114
  • TrainResult sheet_after macro run-min.jpg
    TrainResult sheet_after macro run-min.jpg
    206.9 KB · Views: 149
  • Westbound timetable sheet-min.jpg
    Westbound timetable sheet-min.jpg
    231.6 KB · Views: 148

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
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
 
Upvote 0
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?
 
Upvote 0
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?
 
Upvote 0
It does have debug but when I select it it doesn't highlight any specific line which is far from helpful
 
Upvote 0
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
 
Upvote 0
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)
 
Upvote 0
I've just run your code with limited colums /rows and with the check code removed and it loops through all rows columns
 
Upvote 0
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"
 
Upvote 0
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"
It might be helpful if you can upload a copy of your workbook to a file sharing site and provide a link to it here.
Then people here can download your file and work on the exact same thing you are.

And if you can detail the exact same steps you are doing that is producing this scenario, we can duplicate it exactly to see what is going on.
 
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,196
Members
452,616
Latest member
intern444

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top