MrExcel Publishing
Your One Stop for Excel Tips & Solutions

My ugly as sin/ clumsy macro


Posted by Barry Ward on August 07, 2001 9:03 AM

I have a macro that I've basically thrashed together by recording individual bits in excel and pasting them together, I know thue look of it would probably upset anyone who knows VBA but I don't and I need to know two things:

1)

How can I avoid having to close the worksheet (without saving it) and then re-opening it so I can paste in the next set of data?

2)

Can I speed it up?

This is an example of the data followed by the code:

cl 31-40
sw 1.1
20
21
22
23
24
25
26
27
28 1
29
30
31 2
32 7
33 13
34 9
35 15
36 15
37 7
38 4
39
40 2
41 1
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

Sub Unbin()
'
' Unbin Macro
' Macro recorded 02/08/2001 by Ward
'

'
Range("A3:a63").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=90
Range("A64").Select
ActiveSheet.paste
Range("B64").Select
ActiveCell.FormulaR1C1 = "=OFFSET(RC[-1],-1,1)-1"
Range("B64").Select
Selection.AutoFill Destination:=Range("B64:B124"), Type:=xlFillDefault
Range("B64:B124").Select
Range("B64").Select
ActiveCell.FormulaR1C1 = "=OFFSET(RC[-1],-1,1)-1"
Range("B64").Select
Selection.AutoFill Destination:=Range("B64:B124"), Type:=xlFillDefault
Range("B64:B124").Select
Range("D3").Select
ActiveCell.FormulaR1C1 = "=MAX(RC[-2]:R[60]C[-2])"
Range("E3").Select
ActiveCell.FormulaR1C1 = "=(RC[-1]-1)*61+63"
ActiveWindow.LargeScroll Down:=0
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollRow = 56
Range("A64:B124").Select
Selection.Copy
ActiveWindow.LargeScroll Down:=2
Range("A125:B" & (Range("D3").Value - 1) * 61 + 63).Select
ActiveSheet.paste
Range("a3:b" & (Range("D3").Value - 1) * 61 + 63).Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'modified from http://support.microsoft.com/support/kb/articles/Q213/5/44.asp
'see http://www.geocities.com/davemcritchie/excel/delempty.htm

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'pre XL97 xlManual
Dim rng As Range, i As Long '// modified

'Set the range to evaluate to rng. // modified
Set rng = Intersect(Selection, ActiveSheet.UsedRange)
If rng Is Nothing Then
MsgBox "nothing in Intersected range to be checked"
GoTo done
End If

'Loop backwards through the rows
'in the range that you want to evaluate.
'--- For i = rng.Rows.Count To 1 Step -1 // modified

For i = rng.count To 1 Step -1

'If cell i in the range contains an "0", delete the entire row.
If rng.Cells(i).Value <= "0" Then rng.Cells(i).EntireRow.Delete
Next
done:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

'calculates which cells still active in column A and names the array "cl".

ActiveWorkbook.Names.Add Name:="CL", RefersToR1C1:= _
"=OFFSET(Sheet1!R1C1,2,0,COUNTA(Sheet1!C1),1)"

'Runs the descriptive statistics module

Run "Descr", ActiveSheet.Range("cl"), _
ActiveSheet.Range("$E$1"), "C", False, True, , , 95

Range("$E:$F").Select
Selection.Columns.AutoFit

End Sub



Posted by Malc on August 08, 2001 1:37 AM

Unbin Macro Macro recorded 02/08/2001 by Ward 'calculates which cells still active in column A and names the array "cl". ActiveWorkbook.Names.Add Name:="CL", RefersToR1C1:= _ "=OFFSET(Sheet1!R1C1,2,0,COUNTA(Sheet1!C1),1)" 'Runs the descriptive statistics module Run "Descr", ActiveSheet.Range("cl"), _ ActiveSheet.Range("$E$1"), "C", False, True, , , 95 Range("$E:$F").Select Selection.Columns.AutoFit End Sub

You shouldn't haven't to close the sheet to copy in the macro. In the code editor insert a blank macro sheet and then record a macro. Excel will insert another macro sheet with the recorded macro on it. Copy the pecies you want from this and paste them into the ,acro sheet you inserted. Flick between the macro sheets in the box on the right hand side on the code editor.

Making it goes faster. Start with strpping out uncessary code like the
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollRow = 56
and put some for next loops in so your not repeating the same action over & over in code.
Could also put application.screenupdating = false at the top to stop the screen flickering but there's no fun watching a blank screen

You code looks OK try experimenting and use the help screens heaps.