Hi Tristan,

Thanks very much for your help, for taking the time to write the code and for the offer of more help if needed. My school project is due at the end of the week and I'm almost there with it but just been a bit stuck.

On adding the code and running it an error comes up about the final "paste" in the code being incorrect but I'm not sure why.

I didn't explain in my first post but the program starts by opening a new visual basic applciation, workbook and sheets etc. The program runs from one excel document and creates another. I don't know if this has anything to do wth the location it is trying to paste in. In other parts of the code I've had to be specific about which sheet I'm using eg oWB.worksheets(..... instead of just worksheets(......


It may be easier if I paste you my program so far
'Option Explicit
Option Base 1
Dim Heats As Integer

      Dim oXL As Excel.Application
      Dim oWB As Excel.Workbook
      Dim oSheet As Excel.Worksheet
      Dim oRng As Excel.Range
   
   Private Sub CmdEnter_Click()
      'On Error GoTo Err_Handler
      
   ' Start Excel and get Application object.
      Set oXL = CreateObject("Excel.Application")
      oXL.Visible = True
      
   ' Get a new workbook.
      Set oWB = oXL.Workbooks.Add
      Set oSheet = oWB.ActiveSheet
      
   ' Add table headers going cell by cell.
      oSheet.Cells(1, 1).Value = "Name"
      oSheet.Cells(1, 2).Value = "Heat"
      oSheet.Cells(1, 3).Value = "Position"
      oSheet.Cells(1, 4).Value = "Time"

    'Renaming Main sheet = Data list
        oSheet.Name = "Data list"
'Delete Sheets 2 and 3 (unused sheets)
oXL.Sheets(2).Delete
oXL.Sheets(2).Delete



   ' Format A1:D1 as bold, vertical alignment = center.
      With oSheet.Range("A1", "C1")
         .Font.Bold = True
         .VerticalAlignment = xlVAlignCenter
      End With

      Heats = InputBox("Enter number of heats")
      
   Dim competitors As Integer
   competitors = InputBox("Enter number of competitors")




Dim sheetnew As Integer
For sheetnew = 1 To Heats
oWB.Worksheets.Add(after:=oWB.Worksheets(oWB.Worksheets.Count)).Name = "Heat " & sheetnew
Next sheetnew



'Dim Arrays
Dim saName() As String
Dim saHeat() As Integer
Dim saPosition() As Integer
Dim saTime() As Single

Dim comps As Integer


'Redim arrays with number of competitors
ReDim saName(competitors) As String
ReDim saHeat(competitors) As Integer
ReDim saPosition(competitors) As Integer
ReDim saTime(competitors) As Single

'Loop for all passengers
For comps = 1 To competitors

    Call Enter_Name(saName(), comps)

    Call Enter_Heat(saHeat(), comps)

    'Call Enter_Position(saPosition(), comps)
    Call Enter_Time(saTime(), comps)
    
Next comps


Dim rolo As Integer


   
   ' Fill A2:A6 with an array of values (Names).
    For rolo = 2 To (competitors + 1)
            oSheet.Cells(rolo, 1).Value = saName((rolo - 1))
   Next rolo

rolo = 0

   ' Fill B2:B6 with an array of values (Heats).
    For rolo = 2 To (competitors + 1)
           oSheet.Cells(rolo, 2).Value = saHeat((rolo - 1))
  Next rolo
  
  rolo = 0
  
   ' Fill C2:C6 with an array of values (Positions).
    For rolo = 2 To (competitors + 1)
            oSheet.Cells(rolo, 3).Value = saPosition((rolo - 1))
   Next rolo
      
      
         ' Fill D2:D6 with an array of values (Times).
    For rolo = 2 To (competitors + 1)
            oSheet.Cells(rolo, 4).Value = saTime((rolo - 1))
   Next rolo
      
         ' Format D2:D6(Times).
    For rolo = 2 To (competitors + 1)
            oSheet.Cells(rolo, 4).NumberFormat = "0.00"
   Next rolo

    
Call FindAndCopyRows
    
    

End Sub

Private Sub Enter_Name(ByRef saName() As String, ByVal comps As Integer)

saName(comps) = InputBox("Enter name")

End Sub

Private Sub Enter_Heat(ByRef saHeat() As Integer, ByVal comps As Integer)

saHeat(comps) = GetValidHeat

End Sub


Private Sub Enter_Position(ByRef saPosition() As Integer, ByVal comps As Integer)

saPosition(comps) = GetValidPosition

End Sub

Private Sub Enter_Time(ByRef saTime() As Single, ByVal comps As Integer)

saTime(comps) = GetValidTime

End Sub



''Functions''

Function GetValidName() As String

GetValidName = InputBox("Enter name of competitor", "Competitor Name input")


End Function



Function GetValidHeat() As Integer

Dim Num As Integer
Dim NumberValid As Boolean

NumberValid = False

Do
    Num = InputBox("Please enter heat", "Heat")
    'Seat must be in range of 1 to Number of Heats
    If (Num >= 1) And (Num <= Heats) Then NumberValid = True
    If Not NumberValid Then MsgBox ("That heat was not in the range of 1 to " & Heats)
Loop Until NumberValid

GetValidHeat = Num

End Function

Function GetValidTime() As Single

Dim Num As Single
Dim NumberValid As Boolean

NumberValid = False

Do
    Num = InputBox("Please enter time", "Time")
    'Seat must be in range of 1 to 1000
    If (Num >= 1) And (Num <= 1000) Then NumberValid = True
    If Not NumberValid Then MsgBox ("Incorrect input, Please Re-enter")
Loop Until NumberValid

GetValidTime = Num

End Function


Function GetValidPosition() As Integer

Dim Num As Integer
Dim NumberValid As Boolean

NumberValid = False

Do
    Num = InputBox("Please enter position", "Position")
    'Seat must be in range of 1 to 8
    If (Num >= 1) And (Num <= 8) Then NumberValid = True
    If Not NumberValid Then MsgBox ("Incorrect input, Please Re-enter")
Loop Until NumberValid

GetValidPosition = Num

End Function

Private Sub cmdQuit_Click()
End
End Sub


Sub FindAndCopyRows()

Dim DataListLastRow As Integer
Dim Number As Integer
Dim DataList As Worksheet
Dim i As Integer
Dim j As Integer

Set DataList = Worksheets("DataList")
DataListLastRow = DataList.Cells(65536, 2).End(xlUp).Row


For i = 1 To DataListLastRow
    Number = DataList.Cells(i, 2)
    
    For j = 2 To Worksheets.Count
        If Worksheets(j).Name = "Heat_" & Number Then GoTo InsertHeat
    Next j
        
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    Worksheets(Worksheets.Count).Name = "Heat_" & Number

InsertHeat:
    
    DataList.Select
    
    With Worksheets("Heat_" & Number)
        DataList.Rows(i).Copy
        Paste (.Cells(65536, 1).End(xlUp).Offset(1, 0))
    End With
    
Next i

End Sub

Any ideas?

I wouldn't usually ask for so much help with this, its just I've got a really tight deadline and still have the report to write as well with teachers puting pressure on me.

Thanks again

cleaco