PDA

View Full Version : Solved: Message Box Input calls Tab Name



ajrob
06-13-2008, 05:39 PM
I'm hoping this is an easy one...

I've got multiple tabs named in a workbook called:
> 2008 Ladder
> 2009 Ladder
> 2010 Ladder
> etc.

I've written some basic code that copies a section from the 2008 Ladder tab, and pastes (as a value), to a tab called OpenProv1.

The structure of each of the tabs above is the same, and would I'd like to do is to specify which one to copy from. My thought was to put in a Message Box asking for the Year, then concatenating YYYY + Ladder, and referencing that in the code. But, any other ideas would be welcome.

Here's the code I've written, would appreciate any tips.

Thanks


' Copies info contained in 2007 Ladder, then
'formats contents in the "OpenProv1" worksheet.
Sheets("2008 Ladder").Select
Range("B9:J500").Select
Selection.Copy
Range("B9").Select
Sheets("OpenProv1").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("2008 Ladder").Select
Range("Q9:V500").Select
Selection.Copy
Range("B9").Select
Sheets("OpenProv1").Select
Range("L4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("2008 Ladder").Select
Range("Y9:AI500").Select
Selection.Copy
Range("B9").Select
Sheets("OpenProv1").Select
Range("S4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("2008 Ladder").Select
Range("DC9C500").Select
Selection.Copy
Range("B9").Select
Sheets("OpenProv1").Select
Range("AE4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("2008 Ladder").Select
Range("DG9R500").Select
Selection.Copy
Range("B9").Select
Sheets("OpenProv1").Select
Range("AG4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rows("4:500").Select
With Selection.Font
.Name = "Arial Narrow"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.ColorIndex = 1
End With


Edit: VBA tags added to your code. If you select your code when you post and hit the VBA button it will be formatted as above.

Simon Lloyd
06-14-2008, 03:45 AM
It's an InputBox rather than a message box, i've incorporated one for you, when you run the code you will be asked for the year:

' Copies info contained in 2007 Ladder, then
'formats contents in the "OpenProv1" worksheet.
Dim IB As String, IBLad As String
IB = InputBox("Enter a year date in this format" & Chr(34) & "2008" & Chr(34), "Sheet Name selection")
IBLad = IB & " Ladder"
Sheets(IBLad).Select
Range("B9:J500").Select
Selection.Copy
Range("B9").Select
Sheets("OpenProv1").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets(IBLad).Select
Range("Q9:V500").Select
Selection.Copy
Range("B9").Select
Sheets("OpenProv1").Select
Range("L4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets(IBLad).Select
Range("Y9:AI500").Select
Selection.Copy
Range("B9").Select
Sheets("OpenProv1").Select
Range("S4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets(IBLad).Select
Range("DC9C500").Select
Selection.Copy
Range("B9").Select
Sheets("OpenProv1").Select
Range("AE4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets(IBLad).Select
Range("DG9R500").Select
Selection.Copy
Range("B9").Select
Sheets("OpenProv1").Select
Range("AG4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rows("4:500").Select
With Selection.Font
.Name = "Arial Narrow"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.ColorIndex = 1
End With

Ago
06-15-2008, 03:00 PM
just reading that code gives me headace, i can just imagine how it will look when all those selects are running.

i made the code a bit nicer on your eyes and smaler.

just look carefully at the columns, im not 100% sure i got them correct.


' Copies info contained in 2007 Ladder, then
'formats contents in the "OpenProv1" worksheet.
Dim IB As String, IBLad As String
IB = InputBox("Enter a year date in this format" & Chr(34) & "2008" & Chr(34), "Sheet Name selection")
IBLad = IB & " Ladder"
Sheets("OpenProv1").Range("B4:J494").Value = Sheets(IBLad).Range("B9:J500").Value
Sheets("OpenProv1").Range("L4:Q494").Value = Sheets(IBLad).Range("Q9:V500").Value
Sheets("OpenProv1").Range("S4:AC494").Value = Sheets(IBLad).Range("Y9:AI500").Value
Sheets("OpenProv1").Range("EE494:AE4").Value = Sheets(IBLad).Range("DC9:C500").Value
Sheets("OpenProv1").Range("DQ494:AG4").Value = Sheets(IBLad).Range("DG9:R500").Value
With Sheets("OpenProv1").Rows("4:500").Font
.Name = "Arial Narrow"
.Size = 10
End With

Simon Lloyd
06-15-2008, 03:06 PM
Lol Ago, i just used VBA replace to add the IBLad and added the inputbox, i wasn't going to wade through all that recorded code, as you said it makes your head hurt! ;)

Ago
06-15-2008, 04:34 PM
did some more fixes.

now you have to type in something in the inputbox and it will give a errormessage if the sheet does not exist.



' Copies info contained in 2007 Ladder, then
'formats contents in the "OpenProv1" worksheet.
Dim IB As String, IBLad As String
While IB = ""
IB = InputBox("Enter a year date in this format" & Chr(34) & "2008" & Chr(34), "Sheet Name selection")
IBLad = IB & " Ladder"
Wend
On Error Resume Next
If Not Sheets(IBLad) Is Nothing Then
If Not Err <> 0 Then
Sheets("OpenProv1").Range("B4:J494").Value = Sheets(IBLad).Range("B9:J500").Value
Sheets("OpenProv1").Range("L4:Q494").Value = Sheets(IBLad).Range("Q9:V500").Value
Sheets("OpenProv1").Range("S4:AC494").Value = Sheets(IBLad).Range("Y9:AI500").Value
Sheets("OpenProv1").Range("EE494:AE4").Value = Sheets(IBLad).Range("DC9:C500").Value
Sheets("OpenProv1").Range("DQ494:AG4").Value = Sheets(IBLad).Range("DG9:R500").Value
With Sheets("OpenProv1").Rows("4:500").Font
.Name = "Arial Narrow"
.Size = 10
End With
Else
MsgBox "Error, sheet " & IBLad & " does not excist"
End If
End If




but i dont know how to let the user "press cancel".
if you press cancel now it will just keep for a year.
anyone?

Ago
06-15-2008, 04:40 PM
lol i just noticed i made one if statment extra complicated.
you could replace

If Not Err <> 0 Then

with

If Err = 0 Then

maybe its time to get to bed now.

mdmackillop
06-16-2008, 06:25 AM
Make full use of With to keep things tidy

If Not Err <> 0 Then
With Sheets("OpenProv1")
.Range("B4:J494").Value = Sheets(IBLad).Range("B9:J500").Value
.Range("L4:Q494").Value = Sheets(IBLad).Range("Q9:V500").Value
.Range("S4:AC494").Value = Sheets(IBLad).Range("Y9:AI500").Value
.Range("EE494:AE4").Value = Sheets(IBLad).Range("DC9:C500").Value
.Range("DQ494:AG4").Value = Sheets(IBLad).Range("DG9:R500").Value
With .Rows("4:500").Font
.Name = "Arial Narrow"
.Size = 10
End With
End With
Else

Ago
06-16-2008, 11:59 AM
very sexy!!
i didnt know you could have two withs like that.