Hi,
In another thread @johnnyL developed a verygood code, which is basically a loop and runs automatically whenever the workbook is refreshed (webquery now set at 2min interval).
Please find the code below:
As part of this code, i would like some additional codelines to be executed only once (ie not looping at each interval but only at the start) to set the workbook up properly.
This code would be as follows:
Now question is how/where do i integrate the additional codelines in the original macro so that it executes only once?
Hope question is clear, if not please shout
thanks a lot!!
Valentino
In another thread @johnnyL developed a verygood code, which is basically a loop and runs automatically whenever the workbook is refreshed (webquery now set at 2min interval).
Please find the code below:
VBA Code:
Private Sub Worksheet_Calculate()
'
' V2.1
'
' 1st 10 minute refresh will create the DestinationSheet if it doesn't exist & will save the conditions column results to create a base line to compare to.
' All other 10 minute refreshes will compare the current condition columns to the previous condition columns and display the Assets that had
' conditions changed to '1' or '-1'
'
' Check the lines at the top of the script that end with ' <---
' Those lines are the lines that may need to be changed to reflect your particular setup.
'
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim CurrentConditionsStartRow As Long, LastRowAssetColummn As Long
Dim CurrentConditionsRange As Range
Dim DestinationSheet As String
Dim AssetColumn As String, StatusColumn As String
Dim FirstConditionColumn As String, SecondConditionColumn As String
Dim ConditionsCombinedColumn As String
Dim wsDestination As Worksheet, wsSource As Worksheet
'
DestinationSheet = "TenMinuteUpdates" ' <--- Set this to the name of the sheet to store 10 minute results into
Set wsSource = ThisWorkbook.Sheets("Sheet1") ' <--- Set this to the sheetname that has the '1's & '0's
'
AssetColumn = "A" ' <--- Set this to the Asset Column letter, this column is used to determine last row
StatusColumn = "B" ' <--- Set this to the column letter of the StatusColumn
FirstConditionColumn = "C" ' <--- Set this to the column letter of the first condition
SecondConditionColumn = "D" ' <--- Set this to the column letter of the second condition
ConditionsCombinedColumn = "E" ' <--- Set this to the column letter of the ConditionsCombined Column
CurrentConditionsStartRow = 2 ' <--- Set this to the start row of CurrentConditions
'
LastRowAssetColummn = wsSource.Range(AssetColumn & _
Rows.Count).End(xlUp).Row ' Determine last row of data
'
Set CurrentConditionsRange = wsSource.Range(FirstConditionColumn & _
CurrentConditionsStartRow & ":" & SecondConditionColumn & _
LastRowAssetColummn) ' Establish the ConditionsRange
'
If Application.CountIf(CurrentConditionsRange, "1") > 0 Or _
Application.CountIf(CurrentConditionsRange, "-1") > 0 Then ' If the ConditionsRange contains any value of 1 or -1 then ...
'
Dim ArrayRowIncremented As Boolean, DestinationSheetExists As Boolean
Dim ConditionsColumnColumn As Long, ConditionsColumnRow As Long
Dim CurrentConditionValue As Long
Dim LastDestinationColumnNumber As Long
Dim OutputArrayRow As Long
'
Dim AssetColumnArray As Variant, CurrentConditionsArray As Variant
Dim DateTimeArray(1 To 2) As Variant
Dim PreviousConditionsArray As Variant, PreviousHeadingsArray(1 To 3) As Variant
Dim OutputArray As Variant, SourceArray As Variant
'
On Error Resume Next ' Bypass error generated in next line if sheet does not exist
Set wsDestination = ThisWorkbook.Sheets(DestinationSheet) ' Assign DestinationSheet to wsDestination
On Error GoTo 0 ' Turn Excel error handling back on
'
If Not wsDestination Is Nothing Then DestinationSheetExists = True ' Check to see if the DestinationSheet exists
'
' Create DestinationSheet if it doesn't exist
If DestinationSheetExists = False Then ' If DestinationSheet does not exist then ...
ThisWorkbook.Sheets.Add(after:=wsSource).Name = DestinationSheet ' Create the DestinationSheet after the Source sheet
Set wsDestination = ThisWorkbook.Sheets(DestinationSheet) ' Assign the DestinationSheet to wsDestination
End If
'
' Load current Conditions into array
CurrentConditionsArray = CurrentConditionsRange ' Load the values of the Condition Columns range into the 2D 1 based
' ' ConditionsArray RC
ReDim OutputArray(1 To UBound(CurrentConditionsArray)) ' Establish # of rows in 1D 1 based OutputArray
'
SourceArray = wsSource.Range(AssetColumn & CurrentConditionsStartRow & _
":" & ConditionsCombinedColumn & LastRowAssetColummn) ' Load all source values into SourceArray
'
' Create Saved conditions result columns on DestinationSheet if they haven't been created yet
If wsDestination.Range("A1") = vbNullString Then ' If previous conditions have not been saved then ...
PreviousHeadingsArray(1) = Date ' Save Date into PreviousHeadingsArray
PreviousHeadingsArray(2) = Time() ' Save Time into PreviousHeadingsArray
PreviousHeadingsArray(3) = "------------------" ' Save space line into PreviousHeadingsArray
wsDestination.Range("A1").Resize(UBound(PreviousHeadingsArray, 1)) _
= Application.Transpose(PreviousHeadingsArray) ' Save PreviousHeadingsArray to destination sheet
'
wsDestination.Range("A4").Resize(UBound(CurrentConditionsArray, 1), _
UBound(CurrentConditionsArray, 2)) = CurrentConditionsArray ' Display CurrentConditionsArray to DestinationSheet
'
wsDestination.UsedRange.EntireColumn.AutoFit ' Autofit all of the columns
'
GoTo SubExit ' Exit this subroutine
End If
'
' Load previous conditions results into array
PreviousConditionsArray = wsDestination.Range("A4:B" & _
wsDestination.Range("A" & Rows.Count).End(xlUp).Row) ' Load previous conditions results into PreviousConditionsArray
' ' AssetColumnArray RC
'-------------------------------------------------------------------
'
' Find and save changes from zero
OutputArrayRow = 0 ' Initialize OutputArrayRow to zero
'
For ConditionsColumnRow = 1 To UBound(CurrentConditionsArray, 1) ' Loop through the CurrentConditionsArray rows to check for '1's & '-1's
For ConditionsColumnColumn = 1 To UBound(CurrentConditionsArray, 2) ' Loop through the CurrentConditionsArray columns to check for '1's & '-1's
'
CurrentConditionValue = CurrentConditionsArray(ConditionsColumnRow, _
ConditionsColumnColumn) ' Get the CurrentConditionValue
'
If CurrentConditionValue = "1" Or CurrentConditionValue = "-1" Then ' If a '1' or '-1' is found then ...
'
If PreviousConditionsArray(ConditionsColumnRow, _
ConditionsColumnColumn) = 0 Then ' If previous value was '0' then ...
If ArrayRowIncremented = False Then ' If we haven't already incremented OutputArrayRow then ...
OutputArrayRow = OutputArrayRow + 1 ' Increment OutputArrayRow
ArrayRowIncremented = True ' Set ArrayRowIncremented flag = True
End If
'
If OutputArray(OutputArrayRow) = vbNullString Then ' If OutputArray cell is blank then ...
OutputArray(OutputArrayRow) = "(" & _
SourceArray(ConditionsColumnRow, 5) & ") " & _
SourceArray(ConditionsColumnRow, 1) & " " & _
SourceArray(ConditionsColumnRow, 2) ' Save desired result to OutputArray
End If
End If
End If
Next ' Loop Back
'
ArrayRowIncremented = False ' Reset the ArrayRowIncremented to False
Next ' Loop Back
'
'-------------------------------------------------------------------
'
' Save found changes to the DestinationSheet
LastDestinationColumnNumber = wsDestination.Cells.Find("*", _
, xlFormulas, , xlByColumns, xlPrevious).Column ' Get last Column Number used in the DestinationSheet
'
DateTimeArray(1) = Date
DateTimeArray(2) = Time()
wsDestination.Cells(1, LastDestinationColumnNumber + _
1).Resize(UBound(DateTimeArray, 1)) = _
Application.Transpose(DateTimeArray) ' Display Date & Time to Destination sheet
'
wsDestination.Cells(4, LastDestinationColumnNumber _
+ 1).Resize(UBound(OutputArray)) = _
Application.Transpose(OutputArray) ' Display results to DestinationSheet
'
'-------------------------------------------------------------------
'
'Save ConditionsArray to the DestinationSheet
wsDestination.Range("A1").Resize(UBound(DateTimeArray, 1)) _
= Application.Transpose(DateTimeArray) ' Display Date & Time to destination sheet
'
wsDestination.Range("A4").Resize(UBound(CurrentConditionsArray, 1), _
UBound(CurrentConditionsArray, 2)) = CurrentConditionsArray ' Display results to DestinationSheet
'
wsDestination.UsedRange.EntireColumn.AutoFit ' Autofit all of the columns
End If
'
'-------------------------------------------------------------------
SubExit:
Sheets("Historical").Range("b1:c101").EntireColumn.Insert
Sheets("Historical").Range("b1:c101").Value = Sheets("Daily").Range("Al1:Am101").Value
Sheets("Historical").Range("il1:iz101").EntireColumn.Delete
Application.Goto Sheets("Historical").Range("a1")
Sheets("DatasheetSelfData").Range("a1:ds101").Value = Sheets("DatasheetSelf").Range("A1:ds101").Value
Sheets("DatasheetSelfData").Range("eb108:ed208").Value = Sheets("DatasheetSelfData").Range("dt108:dv208").Value
Sheets("SFPSelf").Range("cd1:cd101").Value = Sheets("SFPSelf").Range("cb1:cb101").Value
Sheets("TenMinuteUpdates").Range("A4", Sheets("TenMinuteUpdates").Range("A4").End(xlDown)) = 0
Application.Goto Sheets("TenMinuteUpdates").Range("a1")
Application.EnableEvents = True
Application.ScreenUpdating = True
End SubAs part of this code, i would like some additional codelines to be executed only once (ie not looping at each interval but only at the start) to set the workbook up properly.
This code would be as follows:
VBA Code:
Sub Once()
' OnceMacro
Sheets("DatasheetSelfData").Range("eb108:ec208").Value = Sheets("DatasheetSelfData").Range("a108:b208").Value
Sheets("DatasheetSelfData").Range("ed108:ed208").Value = Sheets("DatasheetSelfData").Range("ec108:ec208").Value
End SubNow question is how/where do i integrate the additional codelines in the original macro so that it executes only once?
Hope question is clear, if not please shout
thanks a lot!!
Valentino
