tiredofit
Well-known Member
- Joined
- Apr 11, 2013
- Messages
- 1,832
- Office Version
- 365
- 2019
- Platform
- Windows
One way to to allow users to intercept code when it's running is to use DoEvents.
The problem I have is despite having added DoEvents, my program crashes. I do have a working version and will explain later.
Firstly in wksData, I have 5 columns of data. Column A contains date, columns B through to E contains the data. In order to follow the code, cell A2 should contain the date 4/1/1984. Then A3 should be 5/1/1984, etc.
Columns B to E can contain any values.
Ensure you have data from row 2 down to 10000 just to give the code time to run.
Add three Range Names:
DataStart
Interval
Start
Makes sure these refer to some blank cells on the worksheet, eg M1, N1 and O1.
Then create a line chart manually based on the data.
Here's the code:
This is in wksData, ie the worksheet:
This is in a module called FnLastRow:
This is in ModChartUpdate:
ModReverse:
This is in a class module, called ClsChartUpdate :
This is in a class module, called ClsReverse:
This is in a class module, ClsSettings:
This is the main code, in a standard module called ModTest:
The problem is when I run Test, the chart updates as expected.
However whilst it's running, when I click on a cell on the worksheet and attempt to change its value, the program hangs.
I have added both On Error Resume Next and DoEvents, so didn't expect it to crash.
As explained, I have a workaround but it's convoluted. It a involves adding a Spin Button and these two line of code:
are associated with the Spin Button.
Why it needs to go about in this way, I have no idea.
Any help greatly appreciated.
Thanks
The problem I have is despite having added DoEvents, my program crashes. I do have a working version and will explain later.
Firstly in wksData, I have 5 columns of data. Column A contains date, columns B through to E contains the data. In order to follow the code, cell A2 should contain the date 4/1/1984. Then A3 should be 5/1/1984, etc.
Columns B to E can contain any values.
Ensure you have data from row 2 down to 10000 just to give the code time to run.
Add three Range Names:
DataStart
Interval
Start
Makes sure these refer to some blank cells on the worksheet, eg M1, N1 and O1.
Then create a line chart manually based on the data.
Here's the code:
This is in wksData, ie the worksheet:
Code:
Option Explicit
Dim OrigVal As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target(1, 1).Select
OrigVal = Target(1, 1).Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Call ModReverse.Reverse(Rng:=Target, _
OrigVal:=OrigVal)
End Sub
This is in a module called FnLastRow:
Code:
Option Explicit
Public Function LRowInCol(ByRef wks As Variant, _
ByRef Col As Variant) As Long
On Error GoTo Correction
If TypeName(wks) = "String" Then Set wks = Worksheets(wks)
LRowInCol = wks.Columns(Col).Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, _
SearchFormat:=False).Row
ExitPoint:
On Error GoTo 0
Exit Function
Correction:
LRowInCol = 1
Resume ExitPoint
End Function
This is in ModChartUpdate:
Code:
Option Explicit
Public Sub ChartUpdate()
Dim UpdateChart As ClsChartUpdate
Set UpdateChart = New ClsChartUpdate
Call UpdateChart.ChartUpdate
Set UpdateChart = Nothing
End Sub
ModReverse:
Code:
Option Explicit
Public Sub Reverse(ByRef Rng As Range, _
ByRef OrigVal As Variant)
Dim MyReverse As ClsReverse
Set MyReverse = New ClsReverse
With MyReverse
Set .Rng = Rng
.OrigVal = OrigVal
Call .Reverse
End With
Set MyReverse = Nothing
End Sub
This is in a class module, called ClsChartUpdate :
Code:
Option Explicit
Private ChartSettings As ClsSettings
Private Sub Class_Initialize()
Set ChartSettings = New ClsSettings
With ChartSettings
.Interval = wksData.Range("Interval").Value
.DataStart = wksData.Range("DataStart").Value
End With
End Sub
Private Sub Class_Terminate()
Set ChartSettings = Nothing
End Sub
Public Sub ChartUpdate()
Dim LastRowwksData As Long
LastRowwksData = FnLastRow.LRowInCol(wks:=wksData, _
Col:=1)
Dim DataRng As Range
With wksData
Set DataRng = .Range(.Cells(2, 1), .Cells(LastRowwksData, 1))
End With
Do Until Not IsError(Application.Match(ChartSettings.DataStart, DataRng, 0))
ChartSettings.DataStart = ChartSettings.DataStart + 1
Loop
Start = ChartSettings.DataStart
Dim RowNumber As Long
RowNumber = Application.Match(ChartSettings.DataStart, DataRng, 0)
Set DataRng = Nothing
Dim Cht As Chart
Set Cht = wksData.ChartObjects("Chart 1").Chart
Dim Counter As Integer
With wksData
Cht.FullSeriesCollection(1).XValues = Range(.Cells(RowNumber + 1, 1), .Cells(RowNumber + ChartSettings.Interval, 1))
On Error Resume Next
For Counter = 2 To 5
Cht.FullSeriesCollection(Counter - 1).Values = Range(.Cells(RowNumber + 1, Counter), .Cells(RowNumber + ChartSettings.Interval, Counter))
Next Counter
End With
Set Cht = Nothing
End Sub
This is in a class module, called ClsReverse:
Code:
Option Explicit
Private pRng As Range
Private pOrigVal As Variant
Public Property Get Rng() As Range
Set Rng = pRng
End Property
Public Property Set Rng(ByVal R As Range)
Set pRng = R
End Property
Public Property Get OrigVal() As Variant
OrigVal = pOrigVal
End Property
Public Property Let OrigVal(ByVal OVal As Variant)
pOrigVal = OVal
End Property
Public Sub Reverse()
Application.EnableEvents = False
With Me
.Rng(1).Value = .OrigVal
End With
Application.EnableEvents = True
End Sub
This is in a class module, ClsSettings:
Code:
Option Explicit
Private pInterval As Long
Private pDataStart As Long
Public Property Get Interval() As Long
Interval = pInterval
End Property
Public Property Let Interval(ByVal I As Long)
pInterval = I
End Property
Public Property Get DataStart() As Long
DataStart = pDataStart
End Property
Public Property Let DataStart(ByVal DStart As Long)
pDataStart = DStart
End Property
This is the main code, in a standard module called ModTest:
Code:
Option Explicit
Public Start As Long
Public Initial As ClsSettings
Public DateStart As ClsSettings
Public Sub Test()
Dim Cht As ChartObject
Start = 30685
'*****
' Added so clicking on cells does not stop chart updating.
On Error Resume Next
'*****
Do Until Start = 44124
Set Cht = wksData.ChartObjects("Chart 1")
Cht.Activate
Set Cht = Nothing
With Application
.EnableEvents = False
wksData.Range("DataStart").Value = Start
ActiveCell.Activate
Call ModChartUpdate.ChartUpdate
.EnableEvents = True
End With
DoEvents
Start = Start + 1
Loop
On Error GoTo 0
End Sub
The problem is when I run Test, the chart updates as expected.
However whilst it's running, when I click on a cell on the worksheet and attempt to change its value, the program hangs.
I have added both On Error Resume Next and DoEvents, so didn't expect it to crash.
As explained, I have a workaround but it's convoluted. It a involves adding a Spin Button and these two line of code:
Code:
ActiveCell.Activate
Call ModChartUpdate.ChartUpdate
are associated with the Spin Button.
Why it needs to go about in this way, I have no idea.
Any help greatly appreciated.
Thanks
Last edited: