• 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...

  • 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

Stephen Spittal

New Member
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:
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
 
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
 
Hello Stephen

Check the speed now..Hope this helps.

Code:
Sub DashboardCSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = 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.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox ("dashboard_v.csv Updated")

End Sub
 
try:
Code:
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:
…or shorter code (and perhaps easier to tweak) but I doubt any faster:
Code:
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:
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.
 
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:
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.
 
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.
 
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 …
 
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 …
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.
 
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 …
 
This is my full code, I have attached the file that concerns Sub DashboardCSV as the rest contain restricted data,

Code:
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

'  read only +

'  previously unsaved files


Dim wb As Workbook


'go through all open workbooks

For Each wb In Workbooks

wb.RefreshAll


  'only save those that

  'aren't read only +

  '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
 

Attachments

  • Dashboard CSV.zip
    620.8 KB · Views: 3
Running DashboardCSV here took 17 secs (I only needed to change FPath, otherwise as-is).
Some 2.2k rows are added.
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:
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
 
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
 
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
So is it freezing only when you try to run them all together (or is DashboardCSV freezing the computer by itself)?
 
Back
Top