MrExcel Publishing
Your One Stop for Excel Tips & Solutions

Rewritting of macro

Posted by Ben on November 05, 2001 11:15 AM

Could anyone PLEASE help me write a more concise version of the macro below?

It is designed to look at the table in the tblGym_Bookings sheet and find all the times matching a particular time and then go to the sheet BookingSheet and copy the details into the next cell on the row for that time which has a free cell below as well. The code between start and finish in my version of the macro is repeated for every half an hour until 17:30. which makes it makes it too long.

I thought that it may be possible to have the times listed within the macro, so it says something along the lines of for each of these times if the times in the coloumn equal them then copy them to the correct row in the booking sheet table rather thatn having 24 if formulas.

I have uploaded the workbook without the macro to:


Sub CreateSheet()

Dim Cell As Range
For Each Cell In Sheets("tblGym_Bookings").Range("C2:C300")

If Cell.Offset(0, 0).Text = "07:30" Then
ID = Cell.Offset(0, -1)
Name = Cell.Offset(0, -2)
If ActiveCell = "" And ActiveCell.Offset(1, 0) = "" Then
ActiveCell.Value = Name
ActiveCell.Offset(1, 0).Value = ID
GoTo Finish0730
End If
ActiveCell.Offset(0, 1).Select
GoTo NextCol0730
End If

Application.CutCopyMode = False
End Sub

Posted by Mark O'Brien on November 05, 2001 11:40 AM

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?

Posted by Ben on November 05, 2001 12:14 PM

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.

Posted by Ryan on November 05, 2001 12:35 PM


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.

Posted by Mark O'Brien on November 05, 2001 12:47 PM

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?

Posted by Ben on November 05, 2001 9:57 PM

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


Posted by Ben on November 06, 2001 2:50 AM

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!

Posted by Mark O'Brien on November 06, 2001 7:37 PM

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
'You could put in some code to check the next available slot here e.g.
' 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)

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)
MsgBox "The time " & MyTime & " could not be found on " & BOOKING_SHEET & ".", vbInformation
End If

End Function