View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Gerencsér Gábor Gerencsér Gábor is offline
external usenet poster
 
Posts: 19
Default 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