1. ### Welcome to Chandoo.org Forums. Short message for you

Hi Guest,

Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

Yours,
Chandoo
2. Hi All

Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

Post Spam and you Will Be Deleted as a User

Hui...

3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

# Speed Things up

Discussion in 'VBA Macros' started by Stephen Spittal, Jan 18, 2017.

1. ### Stephen SpittalNew Member

Messages:
12
Good Morning form the UK.

I have a spreadsheet that is a download of a Database and I require to manipulate this to feed into a dashboard data table. I use the code below to do the manipulation but it takes forever and I do not know if or how to make it faster. can anyone help?

Code (vb):

Sub DashboardCSV()

Windows("dashboard_v.csv").Activate

Sheets("dashboard_v").Select

Dim lr As Long, i As Long

Dim FM As Integer

Dim MM As Integer

Dim AM As Integer

Dim NM As Integer

FM = 2

MM = 4

AM = 6

NM = 12

lr = Range("O" & Rows.Count).End(xlUp).Row

For i = lr To 1 Step -1

If Range("O" & i).Value = "-" And Range("O" & i).Offset(0, -9).Value = "MM" And Range("O" & i).Offset(0, -5).Value = "Impact Assessment" And Range("O" & i).Offset(0, -4).Value = "PENDING" Then

For y = 1 To MM

Range("O" & i).EntireRow.Copy

Range("O" & i).EntireRow.Insert shift:=xlShiftDown

Next

Range("O" & i).Value = "03DZ - BZB"

Range("o" & i).Offset(0, 2).Value = "0"

Range("o" & i).Offset(0, 6).Value = "0"

Range("O" & i).Offset(1).Value = "04DZ - BZB"

Range("O" & i).Offset(1, 2).Value = "0"

Range("O" & i).Offset(1, 6).Value = "0"

Range("O" & i).Offset(2).Value = "09DZ - BZE"

Range("O" & i).Offset(2, 2).Value = "0"

Range("O" & i).Offset(2, 6).Value = "0"

Range("O" & i).Offset(3).Value = "12DZ - BZH"

Range("O" & i).Offset(3, 2).Value = "0"

Range("O" & i).Offset(3, 6).Value = "0"

Range("O" & i).Offset(4).Value = "***"

Else

If Range("O" & i).Value = "-" And Range("O" & i).Offset(0, -9).Value = "AM" And Range("O" & i).Offset(0, -5).Value = "Impact Assessment" And Range("O" & i).Offset(0, -4).Value = "PENDING" Then

For y = 1 To AM

Range("O" & i).EntireRow.Copy

Range("O" & i).EntireRow.Insert shift:=xlShiftDown

Next

Range("O" & i).Value = "05DZ - BZC"

Range("O" & i).Offset(0, 2).Value = "0"

Range("O" & i).Offset(0, 6).Value = "0"

Range("O" & i).Offset(1).Value = "06DZ - BZC"

Range("O" & i).Offset(1, 2).Value = "0"

Range("O" & i).Offset(1, 6).Value = "0"

Range("O" & i).Offset(2).Value = "07DZ - BZD"

Range("O" & i).Offset(2, 2).Value = "0"

Range("O" & i).Offset(2, 6).Value = "0"

Range("O" & i).Offset(3).Value = "08DZ - BZD"

Range("O" & i).Offset(3, 2).Value = "0"

Range("O" & i).Offset(3, 6).Value = "0"

Range("O" & i).Offset(4).Value = "10DZ - BZF"

Range("O" & i).Offset(4, 2).Value = "0"

Range("O" & i).Offset(4, 6).Value = "0"

Range("O" & i).Offset(5).Value = "11DZ - BZG"

Range("O" & i).Offset(5, 2).Value = "0"

Range("O" & i).Offset(5, 6).Value = "0"

Range("O" & i).Offset(6).Value = "***"

Else

If Range("O" & i).Value = "-" And Range("O" & i).Offset(0, -9).Value = "FM" And Range("O" & i).Offset(0, -5).Value = "Impact Assessment" And Range("O" & i).Offset(0, -4).Value = "PENDING" Then

For y = 1 To FM

Range("O" & i).EntireRow.Copy

Range("O" & i).EntireRow.Insert shift:=xlShiftDown

Next

Range("O" & i).Value = "01DZ - BZA"

Range("O" & i).Offset(0, 2).Value = "0"

Range("O" & i).Offset(0, 6).Value = "0"

Range("O" & i).Offset(1).Value = "02DZ - BZA"

Range("O" & i).Offset(1, 2).Value = "0"

Range("O" & i).Offset(1, 6).Value = "0"

Range("O" & i).Offset(2).Value = "***"

Else

If Range("O" & i).Value = "-" And Range("O" & i).Offset(0, -9).Value = "NM" And Range("O" & i).Offset(0, -5).Value = "Impact Assessment" And Range("O" & i).Offset(0, -4).Value = "PENDING" Then

For y = 1 To NM

Range("O" & i).EntireRow.Copy

Range("O" & i).EntireRow.Insert shift:=xlShiftDown

Next

Range("O" & i).Value = "01DZ - BZA"

Range("O" & i).Offset(0, 2).Value = "0"

Range("O" & i).Offset(0, 6).Value = "0"

Range("O" & i).Offset(1).Value = "02DZ - BZA"

Range("O" & i).Offset(1, 2).Value = "0"

Range("O" & i).Offset(1, 6).Value = "0"

Range("O" & i).Offset(2).Value = "03DZ - BZB"

Range("O" & i).Offset(2, 2).Value = "0"

Range("O" & i).Offset(2, 6).Value = "0"

Range("O" & i).Offset(3).Value = "04DZ - BZB"

Range("O" & i).Offset(3, 2).Value = "0"

Range("O" & i).Offset(3, 6).Value = "0"

Range("O" & i).Offset(4).Value = "05DZ - BZC"

Range("O" & i).Offset(4, 2).Value = "0"

Range("O" & i).Offset(4, 6).Value = "0"

Range("O" & i).Offset(5).Value = "06DZ - BZC"

Range("O" & i).Offset(5, 2).Value = "0"

Range("O" & i).Offset(5, 6).Value = "0"

Range("O" & i).Offset(6).Value = "07DZ - BZD"

Range("O" & i).Offset(6, 2).Value = "0"

Range("O" & i).Offset(6, 6).Value = "0"

Range("O" & i).Offset(7).Value = "08DZ - BZD"

Range("O" & i).Offset(7, 2).Value = "0"

Range("O" & i).Offset(7, 6).Value = "0"

Range("O" & i).Offset(8).Value = "09DZ - BZE"

Range("O" & i).Offset(8, 2).Value = "0"

Range("O" & i).Offset(8, 6).Value = "0"

Range("O" & i).Offset(9).Value = "10DZ - BZF"

Range("O" & i).Offset(9, 2).Value = "0"

Range("O" & i).Offset(9, 6).Value = "0"

Range("O" & i).Offset(10).Value = "11DZ - BZG"

Range("O" & i).Offset(10, 2).Value = "0"

Range("O" & i).Offset(10, 6).Value = "0"

Range("O" & i).Offset(11).Value = "12DZ - BZH"

Range("O" & i).Offset(11, 2).Value = "0"

Range("O" & i).Offset(11, 6).Value = "0"

Range("O" & i).Offset(12).Value = "***"

End If

End If

End If

End If

Next

Windows("Stage 2 Interactive Change Management Dashboard.xlsm").Activate

ActiveWindow.WindowState = xlMaximized

MsgBox ("dashboard_v.csv Updated")

End Sub
2. ### PCosta87Well-Known Member

Messages:
870
Hi Stephen,

The speed at which a code runs is always dependent on the processing power of the machine it is running on.

That being said, there's a number of "tricks" you can use to speed up the execution of subroutines in VBA... some are simple lines of code (to disable Screen or Status Bar Updates, for instance) and others are related to the actual code and the way it was written (optimization).

Please take a look at the following:
http://datapigtechnologies.com/blog/index.php/ten-things-you-can-do-to-speed-up-your-excel-vba-code/

Note that not all can/should be used in all situations.

Now, for the specific code provided, please upload a sample file if you can and I will gladly take a look at it.

Hope this helps
3. ### MontyWell-Known Member

Messages:
721
Hello Stephen

Check the speed now..Hope this helps.

Code (vb):
Sub DashboardCSV()
Application.ScreenUpdating = False

Windows("dashboard_v.csv").Activate

Sheets("dashboard_v").Select

Dim lr As Long, i As Long

Dim FM As Integer

Dim MM As Integer

Dim AM As Integer

Dim NM As Integer

FM = 2

MM = 4

AM = 6

NM = 12

lr = Range("O" & Rows.Count).End(xlUp).Row

For i = lr To 1 Step -1

If Range("O" & i).Value = "-" And Range("O" & i).Offset(0, -9).Value = "MM" And Range("O" & i).Offset(0, -5).Value = "Impact Assessment" And Range("O" & i).Offset(0, -4).Value = "PENDING" Then

For y = 1 To MM

Range("O" & i).EntireRow.Copy

Range("O" & i).EntireRow.Insert shift:=xlShiftDown

Next

Range("O" & i).Value = "03DZ - BZB"

Range("o" & i).Offset(0, 2).Value = "0"

Range("o" & i).Offset(0, 6).Value = "0"

Range("O" & i).Offset(1).Value = "04DZ - BZB"

Range("O" & i).Offset(1, 2).Value = "0"

Range("O" & i).Offset(1, 6).Value = "0"

Range("O" & i).Offset(2).Value = "09DZ - BZE"

Range("O" & i).Offset(2, 2).Value = "0"

Range("O" & i).Offset(2, 6).Value = "0"

Range("O" & i).Offset(3).Value = "12DZ - BZH"

Range("O" & i).Offset(3, 2).Value = "0"

Range("O" & i).Offset(3, 6).Value = "0"

Range("O" & i).Offset(4).Value = "***"

Else

If Range("O" & i).Value = "-" And Range("O" & i).Offset(0, -9).Value = "AM" And Range("O" & i).Offset(0, -5).Value = "Impact Assessment" And Range("O" & i).Offset(0, -4).Value = "PENDING" Then

For y = 1 To AM

Range("O" & i).EntireRow.Copy

Range("O" & i).EntireRow.Insert shift:=xlShiftDown

Next

Range("O" & i).Value = "05DZ - BZC"

Range("O" & i).Offset(0, 2).Value = "0"

Range("O" & i).Offset(0, 6).Value = "0"

Range("O" & i).Offset(1).Value = "06DZ - BZC"

Range("O" & i).Offset(1, 2).Value = "0"

Range("O" & i).Offset(1, 6).Value = "0"

Range("O" & i).Offset(2).Value = "07DZ - BZD"

Range("O" & i).Offset(2, 2).Value = "0"

Range("O" & i).Offset(2, 6).Value = "0"

Range("O" & i).Offset(3).Value = "08DZ - BZD"

Range("O" & i).Offset(3, 2).Value = "0"

Range("O" & i).Offset(3, 6).Value = "0"

Range("O" & i).Offset(4).Value = "10DZ - BZF"

Range("O" & i).Offset(4, 2).Value = "0"

Range("O" & i).Offset(4, 6).Value = "0"

Range("O" & i).Offset(5).Value = "11DZ - BZG"

Range("O" & i).Offset(5, 2).Value = "0"

Range("O" & i).Offset(5, 6).Value = "0"

Range("O" & i).Offset(6).Value = "***"

Else

If Range("O" & i).Value = "-" And Range("O" & i).Offset(0, -9).Value = "FM" And Range("O" & i).Offset(0, -5).Value = "Impact Assessment" And Range("O" & i).Offset(0, -4).Value = "PENDING" Then

For y = 1 To FM

Range("O" & i).EntireRow.Copy

Range("O" & i).EntireRow.Insert shift:=xlShiftDown

Next

Range("O" & i).Value = "01DZ - BZA"

Range("O" & i).Offset(0, 2).Value = "0"

Range("O" & i).Offset(0, 6).Value = "0"

Range("O" & i).Offset(1).Value = "02DZ - BZA"

Range("O" & i).Offset(1, 2).Value = "0"

Range("O" & i).Offset(1, 6).Value = "0"

Range("O" & i).Offset(2).Value = "***"

Else

If Range("O" & i).Value = "-" And Range("O" & i).Offset(0, -9).Value = "NM" And Range("O" & i).Offset(0, -5).Value = "Impact Assessment" And Range("O" & i).Offset(0, -4).Value = "PENDING" Then

For y = 1 To NM

Range("O" & i).EntireRow.Copy

Range("O" & i).EntireRow.Insert shift:=xlShiftDown

Next

Range("O" & i).Value = "01DZ - BZA"

Range("O" & i).Offset(0, 2).Value = "0"

Range("O" & i).Offset(0, 6).Value = "0"

Range("O" & i).Offset(1).Value = "02DZ - BZA"

Range("O" & i).Offset(1, 2).Value = "0"

Range("O" & i).Offset(1, 6).Value = "0"

Range("O" & i).Offset(2).Value = "03DZ - BZB"

Range("O" & i).Offset(2, 2).Value = "0"

Range("O" & i).Offset(2, 6).Value = "0"

Range("O" & i).Offset(3).Value = "04DZ - BZB"

Range("O" & i).Offset(3, 2).Value = "0"

Range("O" & i).Offset(3, 6).Value = "0"

Range("O" & i).Offset(4).Value = "05DZ - BZC"

Range("O" & i).Offset(4, 2).Value = "0"

Range("O" & i).Offset(4, 6).Value = "0"

Range("O" & i).Offset(5).Value = "06DZ - BZC"

Range("O" & i).Offset(5, 2).Value = "0"

Range("O" & i).Offset(5, 6).Value = "0"

Range("O" & i).Offset(6).Value = "07DZ - BZD"

Range("O" & i).Offset(6, 2).Value = "0"

Range("O" & i).Offset(6, 6).Value = "0"

Range("O" & i).Offset(7).Value = "08DZ - BZD"

Range("O" & i).Offset(7, 2).Value = "0"

Range("O" & i).Offset(7, 6).Value = "0"

Range("O" & i).Offset(8).Value = "09DZ - BZE"

Range("O" & i).Offset(8, 2).Value = "0"

Range("O" & i).Offset(8, 6).Value = "0"

Range("O" & i).Offset(9).Value = "10DZ - BZF"

Range("O" & i).Offset(9, 2).Value = "0"

Range("O" & i).Offset(9, 6).Value = "0"

Range("O" & i).Offset(10).Value = "11DZ - BZG"

Range("O" & i).Offset(10, 2).Value = "0"

Range("O" & i).Offset(10, 6).Value = "0"

Range("O" & i).Offset(11).Value = "12DZ - BZH"

Range("O" & i).Offset(11, 2).Value = "0"

Range("O" & i).Offset(11, 6).Value = "0"

Range("O" & i).Offset(12).Value = "***"

End If

End If

End If

End If

Next

Windows("Stage 2 Interactive Change Management Dashboard.xlsm").Activate

ActiveWindow.WindowState = xlMaximized

Application.ScreenUpdating = True
MsgBox ("dashboard_v.csv Updated")

End Sub
jamesexcel1970 and Arpanakumar like this.
4. ### p45calWell-Known Member

Messages:
694
try:
Code (vb):

Sub DashboardCSV()
'On Error GoTo exitNicely 'reinstate this line after testing.
Application.ScreenUpdating = False
Windows("dashboard_v.csv").Activate
Sheets("dashboard_v").Select
Dim lr As Long, i As Long
Dim FM As Long, MM As Long, AM As Long, NM As Long
FM = 2
MM = 4
AM = 6
NM = 12
lr = Range("O" & Rows.Count).End(xlUp).Row
For i = lr To 1 Step -1
With Range("O" & i)
If .Value = "-" And .Offset(0, -5).Value = "Impact Assessment" And .Offset(0, -4).Value = "PENDING" Then
Select Case .Offset(0, -9).Value
Case "MM"
Rows(i).Offset(1).Resize(MM).Insert
Rows(i).Copy Rows(i).Offset(1).Resize(MM)
.Offset(, 2).Resize(4).Value = "0"
.Offset(, 6).Resize(4).Value = "0"
.Resize(5).Value = Application.Transpose(Array("03DZ - BZB", "04DZ - BZB", "09DZ - BZE", "12DZ - BZH", "***"))
Case "AM"
Rows(i).Offset(1).Resize(AM).Insert
Rows(i).Copy Rows(i).Offset(1).Resize(AM)
.Offset(, 2).Resize(6).Value = "0"
.Offset(, 6).Resize(6).Value = "0"
.Resize(7).Value = Application.Transpose(Array("05DZ - BZC", "06DZ - BZC", "07DZ - BZD", "08DZ - BZD", "10DZ - BZF", "11DZ - BZG", "***"))
Case "FM"
Rows(i).Offset(1).Resize(FM).Insert
Rows(i).Copy Rows(i).Offset(1).Resize(FM)
.Offset(, 2).Resize(2).Value = "0"
.Offset(, 6).Resize(2).Value = "0"
.Resize(3).Value = Application.Transpose(Array("01DZ - BZA", "02DZ - BZA", "***"))
Case "NM"
Rows(i).Offset(1).Resize(NM).Insert
Rows(i).Copy Rows(i).Offset(1).Resize(NM)
.Offset(, 2).Resize(12).Value = "0"
.Offset(, 6).Resize(12).Value = "0"
.Resize(13).Value = Application.Transpose(Array("01DZ - BZA", "02DZ - BZA", "03DZ - BZB", "04DZ - BZB", "05DZ - BZC", "06DZ - BZC", "07DZ - BZD", "08DZ - BZD", "09DZ - BZE", "10DZ - BZF", "11DZ - BZG", "12DZ - BZH", "***"))
End Select
End If
End With  'Range("O" & i)
Next i
Windows("Stage 2 Interactive Change Management Dashboard.xlsm").Activate
ActiveWindow.WindowState = xlMaximized
MsgBox ("dashboard_v.csv Updated")
exitNicely:
Application.ScreenUpdating = True
End Sub
Last edited: Jan 22, 2017
5. ### p45calWell-Known Member

Messages:
694
…or shorter code (and perhaps easier to tweak) but I doubt any faster:
Code (vb):
Sub DashboardCSV2()
'On Error GoTo exitNicely 'reinstate this line after testing.
Application.ScreenUpdating = False
Windows("dashboard_v.csv").Activate
Sheets("dashboard_v").Select
Dim lr As Long, i As Long
Dim FM As Long, MM As Long, AM As Long, NM As Long, ZZ As Long
FM = 2
MM = 4
AM = 6
NM = 12
Dim myArray(2 To 12)
myArray(FM) = Application.Transpose(Array("01DZ - BZA", "02DZ - BZA", "***"))
myArray(MM) = Application.Transpose(Array("03DZ - BZB", "04DZ - BZB", "09DZ - BZE", "12DZ - BZH", "***"))
myArray(AM) = Application.Transpose(Array("05DZ - BZC", "06DZ - BZC", "07DZ - BZD", "08DZ - BZD", "10DZ - BZF", "11DZ - BZG", "***"))
myArray(NM) = Application.Transpose(Array("01DZ - BZA", "02DZ - BZA", "03DZ - BZB", "04DZ - BZB", "05DZ - BZC", "06DZ - BZC", "07DZ - BZD", "08DZ - BZD", "09DZ - BZE", "10DZ - BZF", "11DZ - BZG", "12DZ - BZH", "***"))
lr = Range("O" & Rows.Count).End(xlUp).Row
For i = lr To 1 Step -1
With Range("O" & i)
If .Value = "-" And .Offset(0, -5).Value = "Impact Assessment" And .Offset(0, -4).Value = "PENDING" Then
ZZ = 0
Select Case .Offset(0, -9).Value
Case "MM": ZZ = MM
Case "AM": ZZ = AM
Case "FM": ZZ = FM
Case "NM": ZZ = NM
End Select
If ZZ > 0 Then
Rows(i).Offset(1).Resize(ZZ).Insert
Rows(i).Copy Rows(i).Offset(1).Resize(ZZ)
.Offset(, 2).Resize(ZZ).Value = "0"
.Offset(, 6).Resize(ZZ).Value = "0"
.Resize(ZZ + 1).Value = myArray(ZZ)
End If
End If
End With  'Range("O" & i)
Next i
Windows("Stage 2 Interactive Change Management Dashboard.xlsm").Activate
ActiveWindow.WindowState = xlMaximized
MsgBox ("dashboard_v.csv Updated")
exitNicely:
Application.ScreenUpdating = True
End Sub
Last edited: Jan 22, 2017
jamesexcel1970 and Arpanakumar like this.
6. ### MontyWell-Known Member

Messages:
721
Hi Stephen,

Please acknowledge if it has improved the speed of the macro.
jamesexcel1970 and Arpanakumar like this.
7. ### p45calWell-Known Member

Messages:
694
Monty,
Stephen has probably got the speed he needs - it cost him nothing - so why should he bother acknowledging?

…until he wants more help, whereupon he'll discover his past helpers' willingness to do so has dried up.
8. ### MontyWell-Known Member

Messages:
721
Hello P45cal

We expect when some solution is given and it is working or not ...or further any help required.
we are here to provide answerfor the question...at the same time..we also requiredd help for our questions...
if somebody responds if it is working then it will also help somebody in forum.
Thats the Intension.

Thanks
Last edited: Jan 31, 2017
jamesexcel1970 and Arpanakumar like this.
9. ### p45calWell-Known Member

Messages:
694
I'm 100% with you!
10. ### ArpanakumarMember

Messages:
88
Hello Monty.

I totally agree with you...
11. ### Stephen SpittalNew Member

Messages:
12
I would like to thank you all sorry for the late reply I have been in hospital without access to the internet. I have not had a chance to check all the replys but thank you very much.
Arpanakumar likes this.
12. ### Stephen SpittalNew Member

Messages:
12
I have tried to up load all the files but it says it is too big I will try another way thank you all once again

Messages:
721
14. ### Stephen SpittalNew Member

Messages:
12
Good Morning All,

I have tried all the variations of the code and the code works when I use a small set of data my problem is that when I use the full data set I get a not responding.

I ask in hope that someone is willing to help.
15. ### Marc LExcel Ninja

Messages:
3,029
Hi !

« Not responding » often means a procedure is running,
just wait until its ending …

Adding DoEvents statement just before Next codeline
can help to disapear this non responding state
even if execution may be longer …
16. ### Stephen SpittalNew Member

Messages:
12
Thank you will give it a try
17. ### p45calWell-Known Member

Messages:
694
We'd need a file to experiment on.
18. ### ArpanakumarMember

Messages:
88
Hello Mark.

Adding DoEvents statement just before Next codeline.

Can we use where ever we use loops same case when we have more number of line and loop running it goes not responding mode but still works, how can we make our window active..Please advise.
19. ### Marc LExcel Ninja

Messages:
3,029
As VBA is no multi-tasks, so Excel neither,
when a procedure lasts, you just have to wait until its ending …

DoEvents statement is useful for those who are scary to see
a non response status as a procedure is still running
but can increase execution time, see VBA inner help …
Useful too to manually break a never ending loop in case of a bad design !

Time can be reduced by desactivating during execution properties
ScreenUpdating and Calculation, to see in VBA inner help …

Messages:
12
21. ### Stephen SpittalNew Member

Messages:
12
This is my full code, I have attached the file that concerns Sub DashboardCSV as the rest contain restricted data,

Code (vb):

Function WEEKNR(Datum As Date) As Integer

Dim lnDatum As Long

lnDatum = DateSerial(Year(Datum - Weekday(Datum - 1) + 4), 1, 3)

WEEKNR = Int((Datum - lnDatum + Weekday(lnDatum) + 5) / 7)

End Function

Sub OpenLNKS()

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Workbooks.Open Filename:= _

"H:\Desktop\Type 26 Detail Design Change Managment\dashboard_v.csv"

Workbooks.Open Filename:= _

"H:\Desktop\Type 26 Detail Design Change Managment\change report.xls"

Workbooks.Open Filename:= _

"H:\Desktop\Type 26 Detail Design Change Managment\impact_assessment_cr's_by_team.csv"

End Sub

Sub UpdateCHANGERPT()

Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

Application.DisplayStatusBar = False

Workbooks("change report.xls").Sheets("default").Activate

Range("A:A").Select

With Selection

Selection.NumberFormat = "General"

.Value = .Value

End With

Workbooks("change report.xls").Save

End Sub

Sub UPDATEIABYTEAM()

Workbooks("impact_assessment_cr's_by_team.csv").Sheets("impact_assessment_cr's_by_team").Activate

Rows("1:1").Select

Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Range("I1").Select

Windows("Stage 2 Interactive Change Management Dashboard.xlsm").Activate

Sheets("Design Zones").Select

Range("B2:B13").Select

Selection.Copy

Windows("impact_assessment_cr's_by_team.csv").Activate

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=True

Range("I2").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "2"

Range("J2").Select

ActiveCell.FormulaR1C1 = "3"

Range("K2").Select

ActiveCell.FormulaR1C1 = "4"

Range("L2").Select

ActiveCell.FormulaR1C1 = "5"

Range("M2").Select

ActiveCell.FormulaR1C1 = "6"

Range("N2").Select

ActiveCell.FormulaR1C1 = "7"

Range("O2").Select

ActiveCell.FormulaR1C1 = "8"

Range("P2").Select

ActiveCell.FormulaR1C1 = "9"

Range("Q2").Select

ActiveCell.FormulaR1C1 = "10"

Range("R2").Select

ActiveCell.FormulaR1C1 = "11"

Range("S2").Select

ActiveCell.FormulaR1C1 = "12"

Range("T2").Select

ActiveCell.FormulaR1C1 = "13"

Columns("I:I").Select

Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("I3").FormulaR1C1 = "=CONCATENATE(RC[-8],RC[-3])"

Dim lRowCountb As Long

lRowCountb = Workbooks("impact_assessment_cr's_by_team.csv").Sheets("impact_assessment_cr's_by_team").UsedRange.Rows.Count

p = lRowCountb

With Workbooks("impact_assessment_cr's_by_team.csv").Sheets("impact_assessment_cr's_by_team").Range("I3")

.AutoFill .Resize(p + 1, 1), xlFillCopy

End With

Workbooks("impact_assessment_cr's_by_team.csv").Save

End Sub

Sub DashboardCSV()

On Error GoTo exitNicely

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

workbooks("dashboard_v.csv").Sheets("dashboard_v").activate

Columns("F:F").Select

Selection.Replace What:="-", Replacement:="NM", LookAt:=xlPart, _

SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

ReplaceFormat:=False

Dim lr As Long, i As Long

Dim FM As Long, MM As Long, AM As Long, NM As Long

FM = 2

MM = 4

AM = 6

NM = 12

lr = Range("O" & Rows.Count).End(xlUp).Row

For i = lr To 1 Step -1

With Range("O" & i)

If .Value = "-" And .Offset(0, -5).Value = "Impact Assessment" And .Offset(0, -4).Value = "PENDING" Then

Select Case .Offset(0, -9).Value

Case "MM"

Rows(i).Offset(1).Resize(MM).Insert

Rows(i).Copy Rows(i).Offset(1).Resize(MM)

.Offset(, 2).Resize(4).Value = ""

.Offset(, 6).Resize(4).Value = ""

.Resize(5).Value = Application.Transpose(Array("3DZ - BZB", "4DZ - BZB", "9DZ - BZE", "12DZ - BZH", "***"))

Case "AM"

Rows(i).Offset(1).Resize(AM).Insert

Rows(i).Copy Rows(i).Offset(1).Resize(AM)

.Offset(, 2).Resize(6).Value = ""

.Offset(, 6).Resize(6).Value = ""

.Resize(7).Value = Application.Transpose(Array("5DZ - BZC", "6DZ - BZC", "7DZ - BZD", "8DZ - BZD", "1DZ - BZF", "11DZ - BZG", "***"))

Case "FM"

Rows(i).Offset(1).Resize(FM).Insert

Rows(i).Copy Rows(i).Offset(1).Resize(FM)

.Offset(, 2).Resize(2).Value = ""

.Offset(, 6).Resize(2).Value = ""

.Resize(3).Value = Application.Transpose(Array("1DZ - BZA", "2DZ - BZA", "***"))

Case "NM"

Rows(i).Offset(1).Resize(NM).Insert

Rows(i).Copy Rows(i).Offset(1).Resize(NM)

.Offset(, 2).Resize(12).Value = ""

.Offset(, 6).Resize(12).Value = ""

.Resize(13).Value = Application.Transpose(Array("01DZ - BZA", "02DZ - BZA", "03DZ - BZB", "04DZ - BZB", "05DZ - BZC", "06DZ - BZC", "07DZ - BZD", "08DZ - BZD", "09DZ - BZE", "10DZ - BZF", "11DZ - BZG", "12DZ - BZH", "***"))

End Select

End If

End With  'Range("O" & i)

Next i

ActiveSheet.UsedRange.Replace "-", "", LookAt:=xlWhole

Workbooks("dashboard_v.csv").Save

Dim dtDate As String

dtDate = Format(CStr(Now), "DD MM YYYY HH MM")

Dim Fname As String

Dim Fpath As String

Dim Fnew As String

Fname = "dashboard_v" & dtDate & ".CSV"

Fpath = "H:\Desktop\dashboard_v history\"

Fnew = Fpath & Fname

Workbooks("dashboard_v.csv").SaveCopyAs Filename:=Fnew

MsgBox (Fnew)

MsgBox ("dashboard_v.csv Updated")

exitNicely:

Application.ScreenUpdating = True

End Sub

Sub ChangeManagement()

Application.ScreenUpdating = False

Workbooks("Stage 2 Interactive Change Management Dashboard.xlsm").Sheets("Dashboard Table").Activate

Range("X2").FormulaR1C1 = _

"=IF(COUNTIFS([@[K2_STATE]],""Sent for Impact Assessment"",[@[Assess Status]],""PENDING"")=1,VLOOKUP([@[IA LOOKUP]],'impact_assessment_cr''s_by_team.csv'!C9:C21,HLOOKUP([@BUILDZONE],'impact_assessment_cr''s_by_team.csv'!R1C10:R2C21,2,FALSE),FALSE),dashboard_v.csv!RC[-7])"

If Sheets("Dashboard Table").FilterMode Then

Sheets("Dashboard Table").ShowAllData

Else

End If

Dim i As Long

Dim lRowCount As Long

lRowCount = Workbooks("dashboard_v.csv").Sheets("dashboard_v").UsedRange.Rows.Count

i = lRowCount - 2

With Sheets("Dashboard Table").ListObjects("Table2")

.Resize Range("\$A\$1:\$BF\$" & i)

End With

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Sub

Sub SaveAllOpenFiles()

' saves all open Excel files

' excludes

'  previously unsaved files

Dim wb As Workbook

'go through all open workbooks

For Each wb In Workbooks

wb.RefreshAll

'only save those that

'those not previously saved (new workbooks)

'.Path is the folder path of the file

If Not wb.ReadOnly And Len(wb.Path) <> 0 Then

wb.Save

End If

Next wb

'clears the object variable from memory

Set wb = Nothing

End Sub

Private Sub CommandButton1_Click()

Call OpenLNKS

Call UpdateCHANGERPT

Call UPDATEIABYTEAM

Call DashboardCSV

Call ChangeManagement

Call SaveAllOpenFiles

End Sub

File size:
620.8 KB
Views:
3
22. ### p45calWell-Known Member

Messages:
694
Running DashboardCSV here took 17 secs (I only needed to change FPath, otherwise as-is).
It's an 8+yr. old computer.
Try putting a STOP instruction, (or a breakpoint) before any files are saved in case it's that which is taking the time.
Also you can put a
Debug.Assert i > 13200
line just after:
For i = lr To 1 Step -1
and when you run it will stop at that line when i gets down to 13200, then to move on, press F8 on the keyboard once or twice to move off the Debug line, then adjsut the debug line to a smaller value, say 12500, then press F5 on the keyboard to continue running, etc. etc. which should give you a better idea of what might be slow.
(BTW, there's only one row (row 6309) that inserts new rows above row 10200 on your original csv file.)

This could be done in-memory with arrays, but it would take significant time for me to develop it correctly and tested, and running it that way would take only a fraction of a second or maybe 1 second to update the sheet.

Are you testing the speed of DashboardCSV independently of the other called macros?
Last edited: Feb 20, 2017
23. ### Stephen SpittalNew Member

Messages:
12
Thanks for having a look yeah running independently but trying to get it to run from the main file so that only 1 command button basically the main file has =dashboard.csva2 and so on
24. ### Stephen SpittalNew Member

Messages:
12
I will try and provide the other sheets when at work tomorrow or at least a cut down version. My main when I look at the task manager and running processes I'm see circa 403000 kb memory used when it freezes
25. ### p45calWell-Known Member

Messages:
694
So is it freezing only when you try to run them all together (or is DashboardCSV freezing the computer by itself)?