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]

worked ok on limited data in sheet westbound C5:L12

stepped through the code using F8 and added a debug.print after the Do to show address of all matches in immediate window

I would suggest reducing your data until it starts to work as expected

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
       If searchValue = 0 Then Exit For
       Debug.Print searchValue
       ' 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)
       Set foundCell = wsWestbound.Range("C5:L12").Find(What:=CStr(searchValue), LookIn:=xlValues, LookAt:=xlWhole)
      
       ' Check if any matching cell is found
       If Not foundCell Is Nothing Then
       'Debug.Print foundCell, foundCell.Address
           Do
           Debug.Print foundCell, foundCell.Address
               ' 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:L12").FindNext(foundCell)
               ' Check if the loop has completed a full cycle and returned to the first found cell
'               If foundCell.Address = wsWestbound.Range("C5:L12").Find(What:=CStr(searchValue), LookIn:=xlValues, LookAt:=xlWhole).Address Then
'                   Exit Do ' Exit the loop if it has completed a full cycle
'               End If
               ' Find the next occurrence of the time value
               Set foundCell = wsWestbound.Range("C5:L12").FindNext(foundCell)
               
           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]

ignore the above as its not working if you run it infernal loop

 

[I_know_nuffin]

added the check code back and it gives me the count of matches as expected on the limited data

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:D18")
   ' 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
       If searchValue = 0 Then Exit For
       Debug.Print searchValue
       ' 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)
       Set foundCell = wsWestbound.Range("C5:L12").Find(What:=CStr(searchValue), LookIn:=xlValues, LookAt:=xlWhole)
      
       ' Check if any matching cell is found
       If Not foundCell Is Nothing Then
       'Debug.Print foundCell, foundCell.Address
           Do
           Debug.Print foundCell, foundCell.Address, wsWestbound.Range("C5:L12").Find(What:=CStr(searchValue), LookIn:=xlValues, LookAt:=xlWhole).Address
               ' 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:L12").FindNext(foundCell)
               ' Check if the loop has completed a full cycle and returned to the first found cell
               If foundCell.Address = wsWestbound.Range("C5:L12").Find(What:=CStr(searchValue), LookIn:=xlValues, LookAt:=xlWhole).Address Then
                   Exit Do ' Exit the loop if it has completed a full cycle
               End If
               ' Find the next occurrence of the time value
               'Set foundCell = wsWestbound.Range("C5:L12").FindNext(foundCell)
               
           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]

I have uploaded the spreadsheet to Google Drive and hopefully people can access...thanks in advance for your help

Spreadsheet

 

[philbass1978]

added the check code back and it gives me the count of matches as expected on the limited data

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:D18")
   ' 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
       If searchValue = 0 Then Exit For
       Debug.Print searchValue
       ' 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)
       Set foundCell = wsWestbound.Range("C5:L12").Find(What:=CStr(searchValue), LookIn:=xlValues, LookAt:=xlWhole)
     
       ' Check if any matching cell is found
       If Not foundCell Is Nothing Then
       'Debug.Print foundCell, foundCell.Address
           Do
           Debug.Print foundCell, foundCell.Address, wsWestbound.Range("C5:L12").Find(What:=CStr(searchValue), LookIn:=xlValues, LookAt:=xlWhole).Address
               ' 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:L12").FindNext(foundCell)
               ' Check if the loop has completed a full cycle and returned to the first found cell
               If foundCell.Address = wsWestbound.Range("C5:L12").Find(What:=CStr(searchValue), LookIn:=xlValues, LookAt:=xlWhole).Address Then
                   Exit Do ' Exit the loop if it has completed a full cycle
               End If
               ' Find the next occurrence of the time value
               'Set foundCell = wsWestbound.Range("C5:L12").FindNext(foundCell)
              
           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

Thanks for uploading this...I tried this and it returned the match not found for the data as well as still getting a mismatch type error...I have uploaded the actual file to Googledrive in the hope that once people see what I am trying to achieve it may make it easier to help me...thanks again

 

[I_know_nuffin]

this should stop the error caused by comparing to ""

 If cell.Value = "" Then Exit For

rewrote the loop in below now gives 5 results for the first check time

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
   
   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 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
   If cell.Value = "" Then Exit For
       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)
       ' Debug.Print foundCell.Text
       ' Check if any matching cell is found
       If Not foundCell Is Nothing Then
                      ' Get the head code and location from the corresponding row 2 and column A on the "Westbound" sheet
               headCode = wsWestbound.Cells(2, foundCell.Column + 2).Value
               location = wsWestbound.Cells(foundCell.Row + 2, 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
           Do
           
           Set foundCell = wsWestbound.Range("C5:BD289").FindNext(foundCell)
           If Not foundCell Is Nothing Then
           
           'Debug.Print foundCell.Text, foundCell.Row, foundCell.Column
               ' Get the head code and location from the corresponding row 2 and column A on the "Westbound" sheet
               headCode = wsWestbound.Cells(2, foundCell.Column + 2).Value
               location = wsWestbound.Cells(foundCell.Row + 2, 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
               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
   
   Exit Sub
   
error:
   Stop
   Resume Next
   
   
End Sub

 

[philbass1978]

this should stop the error caused by comparing to ""

 If cell.Value = "" Then Exit For

rewrote the loop in below now gives 5 results for the first check time

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
  
   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 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
   If cell.Value = "" Then Exit For
       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)
       ' Debug.Print foundCell.Text
       ' Check if any matching cell is found
       If Not foundCell Is Nothing Then
                      ' Get the head code and location from the corresponding row 2 and column A on the "Westbound" sheet
               headCode = wsWestbound.Cells(2, foundCell.Column + 2).Value
               location = wsWestbound.Cells(foundCell.Row + 2, 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
           Do
          
           Set foundCell = wsWestbound.Range("C5:BD289").FindNext(foundCell)
           If Not foundCell Is Nothing Then
          
           'Debug.Print foundCell.Text, foundCell.Row, foundCell.Column
               ' Get the head code and location from the corresponding row 2 and column A on the "Westbound" sheet
               headCode = wsWestbound.Cells(2, foundCell.Column + 2).Value
               location = wsWestbound.Cells(foundCell.Row + 2, 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
               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
  
   Exit Sub
  
error:
   Stop
   Resume Next
  
  
End Sub

Thats great, thank you.

I ran the code and it does indeed return values and no error messages however the data returned is not the matches found when I search for the given time value using the excel "find" command. I'm not sure where it is going wrong but for example 06:31:00 returned the train headcode 9V13 when this doesn't have 06:31:00 in its time values.

I am grateful for any more help that can be provided.

 

[I_know_nuffin]

remove the '+ 2' from the below -- it occurs twice in the code

               headCode = wsWestbound.Cells(2, foundCell.Column + 2).Value
               location = wsWestbound.Cells(foundCell.Row + 2, 1).Value

 

[philbass1978]

remove the '+ 2' from the below -- it occurs twice in the code

               headCode = wsWestbound.Cells(2, foundCell.Column + 2).Value
               location = wsWestbound.Cells(foundCell.Row + 2, 1).Value

I removed this and the code is working better and there is no error message for mismatc - thank you.

But not all results are received:
When I look for the time 06:31:00 it should return the following results:
9V12 = NA
9V11 = 17W
9V10 = TS10W_11W
9V09 = TS07W_1
9V08 = Ts03W_2

However the code currently returns:

9V14	TS18W_2
9V10	TS10W_11W
9V09	TS07W_1
9V08	TS03W_2
9V12	N_A

Any ideas?

 

[I_know_nuffin]

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