Trim a fat macro recording

R

Rookie1

I'm not very experienced with VBE, so used the recorder to write
macro.
As you will see below, it is quite redundant. If fact its too large t
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 thi
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 Su
 
G

Gerencsér Gábor

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" <[email protected]> az
alábbiakat írta a következõ hírüzenetben:
(e-mail address removed)...
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
Click to expand...
 
R

Rookie1

Gabor, thanks very much for the info! I will put it in and see wha
happens.
And you are right. I DO NOT want C4 to be the starting point. I mean
do for the first application, but then I need to do the same thing a
K4, AA4 etc.
I want the macro to run from the cell that I select. Do you know how
can do that?
I thought using "ActiveCell.Address" or something like that was a way
but my syntax is pathetic
 
R

Rookie1

Gabor, what if I were to send you the spreadsheet and explain step b
step what I'm trying to accomplish
 
G

Gerencsér Gábor

Let's give it a try, but I am not that good in this.
I have the feeling that this is probably the kind of thing you can solve
with formulas better than with macros.
We post the solution afterwards.
Gabor <[email protected]>

"Rookie1" <[email protected]> az
alábbiakat írta a következõ hírüzenetben:
(e-mail address removed)...
 
E

EvolBob

Below is a shortened version of your code, but I have no idea of what you are trying to do.
You original formula I think was trying to Average certain cells if some other cells were >=-20 and <=20, if so then yours didn't work, so I've use the one below. Replace it if I'm mistaken.


Sub Thinnerzz()
Dim fStr As String, i As Long
fStr = "=IF(D92="""","""",IF(SUMPRODUCT((F91:G91>=-21)*(F91:G91<=20))=2,AVERAGE(F91:G91)/"
For i = 1 To 81
[C4:C84].Formula = fStr & 4.1 - i / 10 & ",B4))"
Cells(85 + i, 3).Resize(1, 2).Value = [F2:G2].Value
Next i
End Sub

Hope this will give you some better ideas on using loops, etc.


Regards
Robert McCurdy


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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Totals An Easier Way?? 5
Macro to delete row if cells greater than certain value 1
Autoamate Concatenate Function 3
how do I write a loop macro? 9
Macro 3
= Today()+1 into Sheet1, Sheet2, and Sheet3 2
Macro autofills formula when a cell value is changed 4
Modify working code to expand the output. 5

Top