Thread
:
Trim a fat macro recording
View Single Post
#
2
Posted to microsoft.public.excel.programming
Gerencsér Gábor
external usenet poster
Posts: 19
Trim a fat macro recording
Try to repeat the recording of one loop using relative references instead of
absolute references.
That will start the procedure relative to the cell that is activated.
For the other one I would suggest you go ahead with trial and error. That's
how you will develop yourself.
Or try this:
(No liability)
Option Explicit
Sub Macro5()
' Keyboard Shortcut: Ctrl+Shift+Q
' ActiveCell.FormulaR1C1 = " "
Dim Cel1
Dim Div1
Cel1=85
Div1=4.1
Do until Div1=-4
Cel1=Cel1+1
Div1=4.1-0.1
Range("C4").Select ' I'm not sure why always C4. Is it intentional, or
should it be also varied ?
ActiveCell.FormulaR1C1 = _
"IF(Sheet1!R[88]C[1]="""","""",IF(AND(Sheet1!R[87]C[3]20,Sheet1!R[87}C[4]20,RC[-1],IF(AND(Sheet1!R[87]C[3]<-20,Sheet1!R[87]C[4]<-20,RC[-1],AVERAGE(Sheet1!R[87]C[3],Sheet1!R[87]C[4])/"
& Div1 & ")))" 'WATCH THIS
Range("C4:C84").Select
Selection.FillDown
Range("F2:G2").Select 'I don't understand why you select this range.
Selection.Copy
Range("C" & Cel1).Select 'WATCH THIS
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Range("E" & Cel1).Select
Application.CutCopyMode = False
Loop
End Sub
Can be trimmed by much more I'm sure.
Gabor
"Rookie1" az
alábbiakat írta a következő hírüzenetben:
...
I'm not very experienced with VBE, so used the recorder to write a
macro.
As you will see below, it is quite redundant. If fact its too large to
compile.
Could someone shorten this up with "Do...Loop" or something similar?
Also, I need the macro to activate from a selected cell, not "C4".
Any help would be much appreciated.
I shortened the actual macro down so it wouldn't be so huge in this
post.
Sub Macro5()
'
' Macro5 Macro
' Macro recorded 3/21/2006 by
'
' Keyboard Shortcut: Ctrl+Shift+Q
ActiveCell.FormulaR1C1 = " "
Range("C4").Select
ActiveCell.FormulaR1C1 = _
"IF(Sheet1!R[88]C[1]="""","""",IF(AND(Sheet1!R[87]C[3]20,Sheet1!R[87}C[4]20,RC[-1],IF(AND(Sheet1!R[87]C[3]<-20,Sheet1!R[87]C[4]<-20,RC[-1],AVERAGE(Sheet1!R[87]C[3],Sheet1!R[87]C[4])/4)))"
Range("C4:C84").Select
Selection.FillDown
Range("F2:G2").Select
Selection.Copy
Range("C86").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E86").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = " "
Range("C4").Select
ActiveCell.FormulaR1C1 = _
"=IF(Sheet1!R[88]C[1]="""","""",IF(AND(Sheet1!R[87]C[3]20,Sheet1!R[87]C[4]20),RC[-1],IF(AND(Sheet1!R[87]C[3]<-20,Sheet1!R[87]C[4]<-20),RC[-1],AVERAGE(Sheet1!R[87]C[3],Sheet1!R[87]C[4])/3.9)))"
Range("C4:C84").Select
Selection.FillDown
Range("F2:G2").Select
Selection.Copy
Range("C87").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E87").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = " "
Range("C4").Select
ActiveCell.FormulaR1C1 = _
"=IF(Sheet1!R[88]C[1]="""","""",IF(AND(Sheet1!R[87]C[3]20,Sheet1!R[87]C[4]20),RC[-1],IF(AND(Sheet1!R[87]C[3]<-20,Sheet1!R[87]C[4]<-20),RC[-1],AVERAGE(Sheet1!R[87]C[3],Sheet1!R[87]C[4])/3.8)))"
Range("C4:C84").Select
Selection.FillDown
Range("F2:G2").Select
Selection.Copy
Range("C88").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E88").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = " "
Range("C4").Select
ActiveCell.FormulaR1C1 = _
"=IF(Sheet1!R[88]C[1]="""","""",IF(AND(Sheet1!R[87]C[3]20,Sheet1!R[87]C[4]20),RC[-1],IF(AND(Sheet1!R[87]C[3]<-20,Sheet1!R[87]C[4]<-20),RC[-1],AVERAGE(Sheet1!R[87]C[3],Sheet1!R[87]C[4])/3.7)))"
Range("C4:C84").Select
Selection.FillDown
Range("F2:G2").Select
Selection.Copy
Range("C89").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E89").Select
Application.CutCopyMode = False
,This continues on down with the "IF" statement divisor
,decreasing by 1/10 each time until it reaches -4 (as seen below)
ActiveCell.FormulaR1C1 = " "
Range("C4").Select
ActiveCell.FormulaR1C1 = _
"=IF(Sheet1!R[88]C[1]="""","""",IF(AND(Sheet1!R[87]C[3]20,Sheet1!R[87]C[4]20),RC[-1],IF(AND(Sheet1!R[87]C[3]<-20,Sheet1!R[87]C[4]<-20),RC[-1],AVERAGE(Sheet1!R[87]C[3],Sheet1!R[87]C[4])/-4)))"
Range("C4:C84").Select
Selection.FillDown
Range("F2:G2").Select
Selection.Copy
Range("C165").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E165").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = " "
Range("E166").Select
End Sub
--
Rookie1
------------------------------------------------------------------------
Rookie1's Profile:
http://www.excelforum.com/member.php...o&userid=32711
View this thread:
http://www.excelforum.com/showthread...hreadid=525406
Reply With Quote
Gerencsér Gábor
View Public Profile
Find all posts by Gerencsér Gábor