Rewritting of macro

I'm looking at your spreadsheet and code just now. what exactly is your problem? Does the code work, but is too slow or do you need someone to make this code work for 0730 to 1730?

Its very slow and if the times need to be changed in the future it will take along time to go all the way through changing the times and inserting new ones.

Ben,

I just did something similiar I think. I have to look at two pages compare them. If a price has changed it posts it in one place, if it is missing somewhere else.

First the way I did it was create a select case to find the right one.
For example you could have cases
case 7:30
case 8:00

then under case you could do your copy and then paste.
Simple way have a new sheet for each time (lots of sheets though). Then on the new sheet once you paste use your Activecell.offset(1,0).
Or you could set up one sheet and then either book mark or find (takes more time) the right time. Then insert the copied row.

My program has about 2500 lines that it compares and takes about 8 minutes. Make sure you use find, I tried a loop at first 20+ minutes.

I may be off on what you are trying to do, I was not 100% sure.

I can make something that will run fast. I need a few questions answered.

1. Does the card number relate to the numbers on the booking sheet? (numbers 1-10) or are these just the number of slots you have for each time period.

2. If a time period is full, what should happen? Just a message saying there are no more slots at that time.

3. Should the name and the card number be displayed on the booking sheet?

1. Just slots for the time period
2. Yes
3. Yes

Thanks!
Ben

No message needed if slots are full

Actually it doesn't matter about a message appearing because the data is from a dataase and I it will be set up so there can't be too many records.Thanks!
Ben

Re: No message needed if slots are full

Just Copy and paste this into a new module.
'I've tried to put all of the things that could change in the declaration
'section, these are the "Public Const" declarations.
'I've commented out some code that will put names and card numbers in the
'next available blank column.
'Any problems just repost, this should be a good start and it doesn't take much time
'to execute. I've tried it on really crappy laptop and over 200 names only take about 5 seconds.
'One limitation is that the names have to be consecutive and no blank rows are allowed.
'This should be too much of a problem since this looks like an Access table anyway.

Option Explicit

'Declare Constants
Public Const GYM_BOOKING As String = "tblGym_Bookings"
Public Const BOOKING_SHEET As String = "BookingSheet"
Public Const FIRST_CELL As String = "C2"
Public Const TIME_COLUMN As String = "B:B"

Public Sub CreateSheet()

'Declare Variables
Dim NextCell As Range
Dim MyTime As Date
Dim TargetCell As Range
Dim TimeFormat As VbDateTimeFormat
Dim i As Integer

'Initialise Variables
Set NextCell = Sheets(GYM_BOOKING).Range(FIRST_CELL)
TimeFormat = vbShortTime

'Begin Code
Do Until NextCell.Value = ""

MyTime = FormatDateTime(NextCell.Value, 4)
Set TargetCell = FindTime(MyTime)

With TargetCell
If .Value = "" And .Offset(0, 1) = "" Then
.Value = NextCell.Offset(0, -2).Value 'Name
.Offset(0, 1).Value = NextCell.Offset(0, -1).Value 'Card Number
Else
'You could put in some code to check the next available slot here e.g.
'Do
' i = i + 1
'Loop Until .Offset(0, i).Value = "" And .Offset(0, (i + 1)).Value = ""
' .Offset(0, i).Value = NextCell.Offset(0, -2).Value
' .Offset(0, (i + 1)).Value = NextCell.Offset(0, -1).Value

End If
' reset counter
i = 0
End With

Set NextCell = NextCell.Offset(1, 0)
Loop

End Sub
Private Function FindTime(ByVal MyTime As Date) As Range

'Declare Variable
Dim c As Range

'Begin Code
Set c = Worksheets(BOOKING_SHEET).Range(TIME_COLUMN).Find(MyTime, LookIn:=xlFormulas)
If Not c Is Nothing Then
Set FindTime = c.Offset(0, 1)
Else
MsgBox "The time " & MyTime & " could not be found on " & BOOKING_SHEET & ".", vbInformation
End
End If

End Function