Macro related question

W

Webem0ch

Hi - I have an Excel workbook containing a large number of worksheets.
Within each worksheet I would like to run a macro to calculate som
dates/numbers/etc.

Is it possible to create a single macro for use on each workshee
within the workbook? I have gotten the macro to run on which eve
worksheet I am viewing, but it returns to me the data from th
worksheet it was originally created upon.

Please advise.

Advance thanks,

Michae
 
W

Webem0ch

Thankyou, Don, for the response.

I am a little new to this could you help me to better understand you
response.

Michae
 
W

Webem0ch

Sub TWBirthdayRelated()
'
' TWBirthdayRelated Macro
' Macro recorded 5/3/2004 by mweber
'
' Keyboard Shortcut: Ctrl+a
'
Range("Q18:R18").Select
Selection.Copy
Range("Q19:R19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
Range("R19").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("R19")
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False
Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True
OtherChar _
:="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1))
_
TrailingMinusNumbers:=True
Range("R19:T19").Select
Range("T19").Activate
Selection.NumberFormat = "0"
Range("R19:S19").Select
Selection.Copy
Range("R20:S24").Select
ActiveSheet.Paste
Range("T20").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C+1"
Range("T20").Select
Selection.AutoFill Destination:=Range("T20:T24")
Type:=xlFillDefault
Range("T20:T24").Select
Range("U19").Select
ActiveCell.FormulaR1C1 = "=RC[-3]&""/""&RC[-2]&""/""&RC[-1]"
Range("U19").Select
Selection.AutoFill Destination:=Range("U19:U24")
Type:=xlFillDefault
Range("U19:U24").Select
Selection.Copy
Range("R19:R24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "[$-409]mmmm d, yyyy;@"
Range("R19").Select
ActiveCell.FormulaR1C1 = "6/21/2003"
Range("R20").Select
ActiveCell.FormulaR1C1 = "6/21/2004"
Range("R21").Select
ActiveCell.FormulaR1C1 = "6/21/2005"
Range("R22").Select
ActiveCell.FormulaR1C1 = "6/21/2006"
Range("R23").Select
ActiveCell.FormulaR1C1 = "6/21/2007"
Range("R24").Select
ActiveCell.FormulaR1C1 = "6/21/2008"
Range("S19:U24").Select
Selection.ClearContents
Range("R25").Select
End Su
 
D

Don Guillett

Here is an idea (UNTESTED) to shorten your code and do each worksheet. Have
a look at each modification to see what is happening. Try on a workbook with
another name.

for each ws in worksheets
Range("Q19:R19").value=Range("Q18:R18")
Range("R19").TextToColumns Destination:=Range("R19"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True,
OtherChar _
:="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True

Range("R19:T19").NumberFormat = "0"
Range("R19:S19").Copy Range("R20:S24")
Range("T20").FormulaR1C1 = "=R[-1]C+1"
Range("T20").AutoFill Destination:=Range("T20:T24"),Type:=xlFillDefault

'Range("T20:T24").Select 'not sure what is happening here

Range("U19").FormulaR1C1 = "=RC[-3]&""/""&RC[-2]&""/""&RC[-1]"
rangeg("u19").AutoFill Destination:=Range("U19:U24"),Type:=xlFillDefault
Range("R19:R24").value=Range("U19:U24")
'Selection.NumberFormat = "[$-409]mmmm d, yyyy;@"
Range("R19") = "6/21/2003"
Range("R20") = "6/21/2004"
Range("R21") = "6/21/2005"
Range("R22") = "6/21/2006"
Range("R23") = "6/21/2007"
Range("R24") = "6/21/2008"
Range("S19:U24").ClearContents
next ws

--
Don Guillett
SalesAid Software
[email protected]
Webem0ch > said:
Sub TWBirthdayRelated()
'
' TWBirthdayRelated Macro
' Macro recorded 5/3/2004 by mweber
'
' Keyboard Shortcut: Ctrl+a
'
Range("Q18:R18").Select
Selection.Copy
Range("Q19:R19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("R19").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("R19"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True,
OtherChar _
:="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)),
_
TrailingMinusNumbers:=True
Range("R19:T19").Select
Range("T19").Activate
Selection.NumberFormat = "0"
Range("R19:S19").Select
Selection.Copy
Range("R20:S24").Select
ActiveSheet.Paste
Range("T20").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C+1"
Range("T20").Select
Selection.AutoFill Destination:=Range("T20:T24"),
Type:=xlFillDefault
Range("T20:T24").Select
Range("U19").Select
ActiveCell.FormulaR1C1 = "=RC[-3]&""/""&RC[-2]&""/""&RC[-1]"
Range("U19").Select
Selection.AutoFill Destination:=Range("U19:U24"),
Type:=xlFillDefault
Range("U19:U24").Select
Selection.Copy
Range("R19:R24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "[$-409]mmmm d, yyyy;@"
Range("R19").Select
ActiveCell.FormulaR1C1 = "6/21/2003"
Range("R20").Select
ActiveCell.FormulaR1C1 = "6/21/2004"
Range("R21").Select
ActiveCell.FormulaR1C1 = "6/21/2005"
Range("R22").Select
ActiveCell.FormulaR1C1 = "6/21/2006"
Range("R23").Select
ActiveCell.FormulaR1C1 = "6/21/2007"
Range("R24").Select
ActiveCell.FormulaR1C1 = "6/21/2008"
Range("S19:U24").Select
Selection.ClearContents
Range("R25").Select
End Sub
Click to expand...
 
T

Tom Ogilvy

Think Don meant for the first line to actually be two lines like this

for each ws in worksheets
ws.Activate

--
Regards,
Tom Ogilvy


Don Guillett said:
Here is an idea (UNTESTED) to shorten your code and do each worksheet. Have
a look at each modification to see what is happening. Try on a workbook with
another name.

for each ws in worksheets
Range("Q19:R19").value=Range("Q18:R18")
Range("R19").TextToColumns Destination:=Range("R19"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True,
OtherChar _
:="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True

Range("R19:T19").NumberFormat = "0"
Range("R19:S19").Copy Range("R20:S24")
Range("T20").FormulaR1C1 = "=R[-1]C+1"
Range("T20").AutoFill Destination:=Range("T20:T24"),Type:=xlFillDefault

'Range("T20:T24").Select 'not sure what is happening here

Range("U19").FormulaR1C1 = "=RC[-3]&""/""&RC[-2]&""/""&RC[-1]"
rangeg("u19").AutoFill Destination:=Range("U19:U24"),Type:=xlFillDefault
Range("R19:R24").value=Range("U19:U24")
'Selection.NumberFormat = "[$-409]mmmm d, yyyy;@"
Range("R19") = "6/21/2003"
Range("R20") = "6/21/2004"
Range("R21") = "6/21/2005"
Range("R22") = "6/21/2006"
Range("R23") = "6/21/2007"
Range("R24") = "6/21/2008"
Range("S19:U24").ClearContents
next ws

--
Don Guillett
SalesAid Software
[email protected]
Webem0ch > said:
Sub TWBirthdayRelated()
'
' TWBirthdayRelated Macro
' Macro recorded 5/3/2004 by mweber
'
' Keyboard Shortcut: Ctrl+a
'
Range("Q18:R18").Select
Selection.Copy
Range("Q19:R19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("R19").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("R19"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True,
OtherChar _
:="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)),
_
TrailingMinusNumbers:=True
Range("R19:T19").Select
Range("T19").Activate
Selection.NumberFormat = "0"
Range("R19:S19").Select
Selection.Copy
Range("R20:S24").Select
ActiveSheet.Paste
Range("T20").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C+1"
Range("T20").Select
Selection.AutoFill Destination:=Range("T20:T24"),
Type:=xlFillDefault
Range("T20:T24").Select
Range("U19").Select
ActiveCell.FormulaR1C1 = "=RC[-3]&""/""&RC[-2]&""/""&RC[-1]"
Range("U19").Select
Selection.AutoFill Destination:=Range("U19:U24"),
Type:=xlFillDefault
Range("U19:U24").Select
Selection.Copy
Range("R19:R24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "[$-409]mmmm d, yyyy;@"
Range("R19").Select
ActiveCell.FormulaR1C1 = "6/21/2003"
Range("R20").Select
ActiveCell.FormulaR1C1 = "6/21/2004"
Range("R21").Select
ActiveCell.FormulaR1C1 = "6/21/2005"
Range("R22").Select
ActiveCell.FormulaR1C1 = "6/21/2006"
Range("R23").Select
ActiveCell.FormulaR1C1 = "6/21/2007"
Range("R24").Select
ActiveCell.FormulaR1C1 = "6/21/2008"
Range("S19:U24").Select
Selection.ClearContents
Range("R25").Select
End Sub
Click to expand...
Click to expand...
 
Top