VBA Guru advice needed

J

jcw78

New Member
Joined
Aug 31, 2006
Messages
3
Hi

I'm really new to this so go easy on me. I have created a macro that does exactly what i want it to do but it takes about 3mins to run(is that slow for the below?). I'm sure i've gone about it a long winded way so was wondering if i can get exactly the same results faster and with neater coding. Here it all is below. Any help would be appreciated

Sub Delit()
' Delete whats there
Sheets("Dash").Activate
Cells.Select
Selection.Delete Shift:=xlUp
End Sub
Sub Importall()
'import all dashboards
Workbooks.Open ("J:\d&c-report-latest.xls")
Sheets("dashboard").Select
Range("rng").Select
Selection.Copy
Windows("redgreen.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Windows("D&C-Report-latest.xls").Activate
ActiveWindow.Close False
Workbooks.Open ("J:\ap-eut-prj-latest.xls")
Sheets("dashboard").Select
Range("rng").Select
Selection.Copy
Windows("redgreen.xls").Activate
Range("a7").End(xlDown).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Windows("ap-eut-prj-latest.xls").Activate
ActiveWindow.Close False
Workbooks.Open ("J:\network-report-latest.xls")
Sheets("dashboard").Select
Range("rng").Select
Selection.Copy
Windows("redgreen.xls").Activate
Range("a7").End(xlDown).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Windows("network-report-latest.xls").Activate
ActiveWindow.Close False
Workbooks.Open ("J:\voice-report-latest.xls")
Sheets("dashboard").Select
Range("rng").Select
Selection.Copy
Windows("redgreen.xls").Activate
Range("a7").End(xlDown).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Windows("voice-report-latest.xls").Activate
ActiveWindow.Close False
End Sub
Sub CritIssues1()
'flag calc
Sheets("Red").Activate
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("Dash").Select
Cells.Select
Selection.Copy
Sheets("Red").Select
Range("A1").Select
ActiveSheet.Paste
ActiveWindow.ScrollColumn = 9
ActiveWindow.LargeScroll ToRight:=-1
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 9
ActiveWindow.SmallScroll ToRight:=4
Range("AG7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(RC[-25]+RC[-21])"
Range("AG7").Select
Selection.AutoFill Destination:=Range("AG7:AG301"), Type:=xlFillDefault
Range("AG7:AG301").Select
ActiveWindow.ScrollRow = 56
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 54
ActiveWindow.ScrollRow = 52
ActiveWindow.ScrollRow = 51
ActiveWindow.ScrollRow = 50
ActiveWindow.ScrollRow = 49
ActiveWindow.ScrollRow = 47
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 44
ActiveWindow.ScrollRow = 42
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 37
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 33
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 1
Range("AH7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-6]=""late"",1,IF(RC[-6]=""on schedule"",0,IF(RC[-6]=""early"",0)))"
Range("AH7").Select
Selection.AutoFill Destination:=Range("AH7:AH301")
Range("AH7:AH301").Select
ActiveWindow.SmallScroll Down:=24
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Range("AI7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-31]=""red"",1,IF(RC[-31]=""green"",0,IF(RC[-31]=""amber"",0)))"
Range("AI7").Select
Selection.AutoFill Destination:=Range("AI7:AI301")
Range("AI7:AI301").Select
Range("AJ7").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-5]>500000,10,IF(RC[-5]<500000,0))"
Range("AJ7").Select
Selection.AutoFill Destination:=Range("AJ7:AJ301")
Range("AJ7:AJ301").Select
Range("AK7").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-4]+RC[-3]+RC[-2]+RC[-1])"
Range("AK7").Select
Selection.AutoFill Destination:=Range("AK7:AK301")
Range("AK7:AK301").Select
End Sub
Sub CritIssues2()
'
' CritIssues2 Macro

ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 14
Range("B6:AK6").Select
Range("AK6").Activate
Selection.AutoFilter
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 15
Selection.AutoFilter Field:=36, Criteria1:=">10", Operator:=xlAnd
Columns("AG:AK").Select
Range("AK1").Activate
Selection.EntireColumn.Hidden = True
Selection.AutoFilter Field:=22, Criteria1:="<100%", Operator:=xlAnd
End Sub
Sub CritIssues3()
'
' CritIssues3 Macro
'
Range("B2:AF2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D4:G4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("H4:K4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("L4:O4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("P4:W4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveWindow.SmallScroll ToRight:=5
Range("X4:Z4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("AA4:AB4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("AC4:AD4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
Sub CritIssues4()
'
' CritIssues4 Macro
'
Range("E2").Select
ActiveWindow.SmallScroll ToRight:=-4
Columns("E:G").Select
Selection.EntireColumn.Hidden = True
Columns("I:K").Select
Selection.EntireColumn.Hidden = True
Columns("M:V").Select
Selection.EntireColumn.Hidden = True
Columns("X:AA").Select
Selection.EntireColumn.Hidden = True
Columns("AC:AD").Select
Selection.EntireColumn.Hidden = True
Range("W4").Select
With Selection.Interior
.ColorIndex = 41
.Pattern = xlSolid
End With
Columns("L:L").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
End Sub
Sub CritIssues5()
'
' CritIssues5 Macro

'
ActiveWindow.SmallScroll ToRight:=-50
Range("A1").Select
End Sub
Sub CritIssues6()
'
' CritIssues6 Macro

'
Range("B2").Select
ActiveCell.FormulaR1C1 = "All Projects Red Flagged > $0.5M"
Range("A1").Select
End Sub
Sub formatit()
'
' formatit Macro
'
Columns("AF:AF").EntireColumn.AutoFit
Columns("AE:AE").EntireColumn.AutoFit
Columns("L:L").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("A:A").EntireColumn.AutoFit
Columns("A:A").Select
Selection.Font.ColorIndex = 1
Columns("A:A").EntireColumn.AutoFit
End Sub
Sub auto_open()
MsgBox "This update will take a couple of minutes"
Application.DisplayAlerts = False

Application.ScreenUpdating = False
Application.Run "'redgreen.xls'!delit"
Application.Run "'redgreen.xls'!importall"
Application.Run "'redgreen.xls'!CritIssues1"
Application.Run "'redgreen.xls'!CritIssues2"
Application.Run "'redgreen.xls'!CritIssues3"
Application.Run "'redgreen.xls'!CritIssues4"
Application.Run "'redgreen.xls'!CritIssues5"
Application.Run "'redgreen.xls'!CritIssues6"
Application.Run "'redgreen.xls'!formatit"

Application.DisplayAlerts = True

End Sub
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
This looks like a recorded macro. You can remove the selections and activation that you don't need. When you format you can also remove what you don't need.

The scrolls are totally useless.
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question Question
ActiveSheet. Paste error
Replies
1
Views
332
RoryA
RoryA
C
  • Solved
VBA Too Slow
Replies
1
Views
280
Cubist
Cubist
P
  • Question Question
Help with Vba Code
Replies
3
Views
414
Coyotex3
C
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
223
rlv01
R
K
  • Solved
formating question
Replies
3
Views
289
Micron
M

Forum statistics

Threads
1,222,248
Messages
6,164,813
Members
451,917
Latest member
WEB78

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top