| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Trim a fat macro recording
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 -- Rookie ----------------------------------------------------------------------- Rookie1's Profile: http://www.excelforum.com/member.php...fo&userid=3271 View this thread: http://www.excelforum.com/showthread.php?threadid=52540 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Trim a fat macro recording
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 -- Rookie ----------------------------------------------------------------------- Rookie1's Profile: http://www.excelforum.com/member.php...fo&userid=3271 View this thread: http://www.excelforum.com/showthread.php?threadid=52540 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Trim a fat macro recording
Gabor, what if I were to send you the spreadsheet and explain step b step what I'm trying to accomplish -- Rookie ----------------------------------------------------------------------- Rookie1's Profile: http://www.excelforum.com/member.php...fo&userid=3271 View this thread: http://www.excelforum.com/showthread.php?threadid=52540 |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Trim a fat macro recording
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 "Rookie1" az alábbiakat írta a következő hírüzenetben: ... Gabor, what if I were to send you the spreadsheet and explain step by step what I'm trying to accomplish? -- Rookie1 ------------------------------------------------------------------------ Rookie1's Profile: http://www.excelforum.com/member.php...o&userid=32711 View this thread: http://www.excelforum.com/showthread...hreadid=525406 |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Trim a fat macro recording
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 "Rookie1" wrote in message ... 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 |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| My excel macro recorder no longer shows up when recording macro | Excel Discussion (Misc queries) | |||
| My excel macro recorder no longer shows up when recording macro | Excel Discussion (Misc queries) | |||
| Trim function in a macro | Excel Programming | |||
| Recording a macro | Excel Programming | |||
| Macro recording | Excel Programming | |||
Linear Mode
