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,