Another "fun" macro problem!! :)

[Beckwa]

Ok the following code I made should change the colour of the booking form i created to black and white and then print two copies of it before changing the colour back. This part works fine. Then it should add parts of the booking form's information to a seperate worksheet, the Booking Database. This works fine the first time but when the second booking is added, it overwrites the first one and doesn't appear underneath it. I have included the code in case it helps at all!! Thanx, BEX
Sub PrintAndAddBooking()
'
' PrintAndAddBooking Macro
' This will print 2 copies of the booking and add it to the database also.
'

'
Application.ScreenUpdating = False
Sheets("Booking Form").Select
ActiveSheet.Unprotect
Sheets("Booking Database").Select
ActiveSheet.Unprotect
Sheets("Booking Form").Select
Cells.Select
Selection.Interior.ColorIndex = 2
Selection.Font.ColorIndex = 0
Range("C5:D7,H5,H6,H9:J9,C9:E9,C11,C12,C13,E15").Select
Range("E15").Activate
Selection.Interior.ColorIndex = 15
Range("E15:F15").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
Cells.Select
Selection.Interior.ColorIndex = 41
Range("B1:I3").Select
Selection.Font.ColorIndex = 8
Range("A5:B7,F5:G5,F6:G6,F9:G9,A9:B9,A11:B11,A12:B12,A13:B13").Select
Range("A13").Activate
Selection.Font.ColorIndex = 37
Range("C5:D7,H5,H6,H9:J9,C9:E9,C11,C12,C13,E15").Select
Range("E15").Activate
Selection.Interior.ColorIndex = 5
Range("A15:D15").Select
Selection.Font.ColorIndex = 2
Sheets("Booking Database").Select
Range("A5").Select
Selection.CurrentRegion.Select
'Check for empty table
If Range("A6") <> "" Then
Selection.End(xlDown).Select
End If
ActiveCell.Offset(1, 0).Range("A1").Select
Sheets("Booking Form").Select
Range("BookingDate").Select
Selection.Copy
Sheets("Booking Database").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Booking Form").Select
Range("BookingNumber").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Booking Database").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Booking Form").Select
Range("MilesTravelled").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Booking Database").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Booking Form").Select
Range("CostForJourney").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Booking Database").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Booking Form").Select
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Booking Database").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End Sub


[ This Message was edited by: Beckwa on 2002-03-21 07:12 ]

[Russell]

Is Cell A5/row 5 blank on the booking database sheet. If so when you select the current region and then use xldown it only takes you A6
Change to Range("A6").select and then select current region

Russell

[Beckwa]

Thanks for the advice but it still isn't working!! Any more ideas? Thanx Bex

[ This Message was edited by: Beckwa on 2002-03-21 07:11 ]

[Joe Was]

Below is a sample of how this concept works. To copy to a list, with each new item being added to the next empty cell below the existing data on the list. You need to find that next empty cell before you paste your copy!

Sub DataList()
'To run you need a data list on Sheet1.
'A lable in A1 on sheet2.
'Select data on sheet1 and run this code.

'Copy the current selection on Sheet1 &
'amend paste selection to bottom of data
'list on Sheet2.

'Copy current selection from data list.
Sheets("Sheet1").Select
Selection.Copy
'Go to Sheet2, find next empty cell to paste to on the new list.
Sheets("Sheet2").Select
ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste

'Go back to Sheet1.
Sheets("Sheet1").Select
Range("A1").Select
End Sub

You should now be able to fix your code, with this simple addition. Hope this helps. JSW

[Beckwa]

Ok that problems sorted but now there's another problem!!! Now the next line is entered where it should but there's a Total costs section underneath the table which needs to move down a row everytime a new line of information is entered. But then the formula which adds up all the numbers in that column doesn't work. I've been doing macros all day and have lost all sense can u tell!! If anyone can help it would be hugely appreciated!!!!