Another "fun" macro problem!! :)

Beckwa

New Member
Joined
Mar 12, 2002
Messages
33
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
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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 :wink: can u tell!! If anyone can help it would be hugely appreciated!!!!
 
Upvote 0

Forum statistics

Threads
1,213,568
Messages
6,114,348
Members
448,570
Latest member
rik81h

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top