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 Spittal

    Stephen Spittal New 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. PCosta87

    PCosta87 Well-Known Member

    Messages:
    658
    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. Monty

    Monty Well-Known Member

    Messages:
    541
    Hello Stephen

    Check the speed now..Hope this helps.

    Code (vb):
    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
    jamesexcel1970 and Arpanakumar like this.
  4. p45cal

    p45cal Well-Known Member

    Messages:
    628
    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. p45cal

    p45cal Well-Known Member

    Messages:
    628
    …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. Monty

    Monty Well-Known Member

    Messages:
    541
    Hi Stephen,

    Please acknowledge if it has improved the speed of the macro.
    jamesexcel1970 and Arpanakumar like this.
  7. p45cal

    p45cal Well-Known Member

    Messages:
    628
    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. Monty

    Monty Well-Known Member

    Messages:
    541
    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. p45cal

    p45cal Well-Known Member

    Messages:
    628
    I'm 100% with you!
  10. Arpanakumar

    Arpanakumar Member

    Messages:
    88
    Hello Monty.

    I totally agree with you...
  11. Stephen Spittal

    Stephen Spittal New 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 Spittal

    Stephen Spittal New 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
  13. Monty

    Monty Well-Known Member

    Messages:
    541
  14. Stephen Spittal

    Stephen Spittal New 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 L

    Marc L Excel Ninja

    Messages:
    2,713
    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 Spittal

    Stephen Spittal New Member

    Messages:
    12
    Thank you will give it a try
  17. p45cal

    p45cal Well-Known Member

    Messages:
    628
    We'd need a file to experiment on.
  18. Arpanakumar

    Arpanakumar Member

    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 L

    Marc L Excel Ninja

    Messages:
    2,713
    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 …
  20. Stephen Spittal

    Stephen Spittal New Member

    Messages:
    12
    Im having difficulty uploading a file
  21. Stephen Spittal

    Stephen Spittal New 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

    '  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

     

    Attached Files:

  22. p45cal

    p45cal Well-Known Member

    Messages:
    628
    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: Feb 20, 2017
  23. Stephen Spittal

    Stephen Spittal New 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 Spittal

    Stephen Spittal New 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. p45cal

    p45cal Well-Known Member

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

Share This Page