How to use Array function to speed up the Macro Run time

0

Hi Experts,

I tried to implement Array function to the attached workexcel sheet with the help of Don's tutorials e.g. Loop Through an Array in Excel VBA Macros and John tutorials sum and merge duplicated data), but I am finding difficulty to implement the same.

Require your expert support to write the Array function to speed up the Macro Run time to below coding:


Option Explicit

Public Interval     As Double

Enum Nws                                        ' worksheet navigation (Sheet1)

    ' 267 (ex 206)

    NwsFirstRow = 5                             ' change to suit

    NwsAvg1 = 3                                 ' change to suit (3 =column C)

    NwsAvg2                                     ' undefined = 1 larger than preceding

    NwsMax1 = 5                                 ' change to suit (5 =column E)

    NwsMin1

    NwsMax2 = 7                                 ' change to suit (7 =column G)

    NwsMin2                                     ' NwsMin2 must be the last column here defined

End Enum

Sub SetTimer()

    ' 178 - TeachExcel.com

    Interval = Now + TimeValue("00:00:10")      ' Set your interval here

    Application.OnTime Interval, "MyMacro"      ' name the time & macro to run

End Sub

Sub StopTimer()

    ' 178 - TeachExcel.com

    On Error Resume Next                        ' Avoid crash if Timer isn't running

    Application.OnTime EarliestTime:=Interval, Procedure:="MyMacro", Schedule:=False

End Sub

Private Sub MyMacro()

    ' 267 (ex 206 - 01 Jul 2021)

    Dim Rl          As Long                 ' last used row in column A

    Dim Arr         As Variant              ' read data from the worksheet

    Dim R           As Long                 ' loop counter: sheet rows

    Dim Ra          As Long                 ' array row number

    'Macro code that you want to run.

    With Worksheets("Sheet1")               ' Change name to suit

        Rl = .Cells(.Rows.Count, "A").End(xlUp).Row

        Arr = .Range(.Cells(NwsFirstRow, 1), .Cells(Rl, NwsMin2)).Value

        For R = NwsFirstRow To Rl

            Ra = R - NwsFirstRow + 1

            RecordMinMax Arr(Ra, NwsAvg1), Arr(Ra, NwsMax1), .Cells(R, NwsMax1), True

            RecordMinMax Arr(Ra, NwsAvg1), Arr(Ra, NwsMin1), .Cells(R, NwsMin1), False

            RecordMinMax Arr(Ra, NwsAvg2), Arr(Ra, NwsMax2), .Cells(R, NwsMax2), True

            RecordMinMax Arr(Ra, NwsAvg2), Arr(Ra, NwsMin2), .Cells(R, NwsMin2), False

        Next R

    End With

    ' enable this line of you want to savwe the change:-

    'ThisWorkbook.Save

    'Calls the timer macro so it can be run again at the next interval.

    SetTimer

End Sub

Private Sub RecordMinMax(ByVal NewVal As Variant, _

                         OldVal As Variant, _

                         Target As Range, _

                         IsMax As Boolean)

    ' 267 (ex 206 - 01 Jul 2021)

    With Target

        If Not IsEmpty(OldVal) Then

            If IsMax Then

                NewVal = WorksheetFunction.Max(NewVal, OldVal)

            Else

                NewVal = WorksheetFunction.Min(NewVal, OldVal)

            End If

        End If

        If NewVal <> OldVal Then .Value = NewVal

    End With

End Sub

Would appreciate your response.

Regards,

Answer
Discuss

Answers

0
Selected Answer

Sunil

You are asking how to use arrays in this file (with code from Variatus) but it ALREADY uses arrays for speed- see the line:

Arr = .Range(.Cells(NwsFirstRow, 1), .Cells(Rl, NwsMin2)).Value
 which populates the array. The file is unchanged from your previous question How can improve the speed of macro run time(sic).

Even on my 10-year old PC, the code (with 200 lines) runs in less than 16 milliseconds so if you have a problem, it could be with the synch between your remote events and timer macro (as Variatus already suggested).

Discuss

Discussion

Thanks John for your response. 
SunilA (rep: 34) Jul 24, '21 at 2:56 pm
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login