I'm working on an Excel that takes input (10-12k points generally), performs some transform calculations to fit data to a model, then plots the points versus the model curve. Often, when viewing the plot, there is errant data that needs to be removed. The old method involved finding the points that caused the bad points, removing them from the dataset, recalculating things and so on. It'd be much nicer if I could graphically select points and remove them that way.
I've overridden chart events and I've made it so that if I click a point, it marks it as an outlier by changing its color to red, clicking changes back. On another sheet, if I click a button it removes the outliers and replots everything. This part works great, no problems.
This is can be a very slow process since there can be lots of points that are outliers. I've implemented a sort of rectangular select to help that. Basically the user holds down shift and clicks two corners. Given that box, the macro goes point by point and checks to see if a datapoint exists there and then marks it for deletion. This has two problems:
1) If there are multiple datapoints at the same gui coordinates, only the top most one gets marked.
2) It is extremely slow.
(2) is more of a priority, but if you have any advice on (1) that'd be great also. I've optimized this code (which runs in the chart mouseup event) as much as I can, but it can still be very slow if the bounding box is small.
The code in question is below with my comments, any help would be greatly appreciated.
Thanks!
(sorry, I'm running Excel 2007 and I can't get the formatting addin to load)
I've overridden chart events and I've made it so that if I click a point, it marks it as an outlier by changing its color to red, clicking changes back. On another sheet, if I click a button it removes the outliers and replots everything. This part works great, no problems.
This is can be a very slow process since there can be lots of points that are outliers. I've implemented a sort of rectangular select to help that. Basically the user holds down shift and clicks two corners. Given that box, the macro goes point by point and checks to see if a datapoint exists there and then marks it for deletion. This has two problems:
1) If there are multiple datapoints at the same gui coordinates, only the top most one gets marked.
2) It is extremely slow.
(2) is more of a priority, but if you have any advice on (1) that'd be great also. I've optimized this code (which runs in the chart mouseup event) as much as I can, but it can still be very slow if the bounding box is small.
The code in question is below with my comments, any help would be greatly appreciated.
Thanks!
(sorry, I'm running Excel 2007 and I can't get the formatting addin to load)
Code:
Private Sub Chart_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
Dim ElementID As Long, Arg1 As Long, Arg2 As Long
Dim curX As Variant, curY As Double
Dim newcolor As Integer
'Disable screen redrawing to improve time
Application.ScreenUpdating = False
'If the user is hold the shift key when click
If Shift = 1 Then
'Mark the boxing procedure as started
bLineClicked = False
bBoxClicked = Not bBoxClicked
'For the first click just store the coordinates
If bBoxClicked Then
lFirstX = x
lFirstY = y
Else 'After the second click, determine the box and process
With ActiveChart
'Determine the left-to-right and top-to-bottom bounds of the box
xStart = Minimum(lFirstX, x)
xEnd = Maximum(lFirstX, x)
yStart = Minimum(lFirstY, y)
yEnd = Maximum(lFirstY, y)
'For every point in the box
For ix = xStart To xEnd
Application.StatusBar = ((ix - xStart) * (yEnd - yStart)) / ((xEnd - xStart) * (yEnd - yStart))
For iy = yStart To yEnd
'Check to see which element is below the ix,iy coordinate
.GetChartElement ix, iy, ElementID, Arg1, Arg2
'If it is a plot point in series 1
If ElementID = xlSeries And Arg1 = 1 Then
'Determine what the points new color should be (red=outlier, blue=ok)
newcolor = nBadColor
If .SeriesCollection(Arg1).Points(Arg2).MarkerBackgroundColorIndex = nBadColor Then
newcolor = nOKColor
End If
'Assign the point color
.SeriesCollection(Arg1).Points(Arg2).MarkerBackgroundColorIndex = newcolor
.SeriesCollection(Arg1).Points(Arg2).MarkerForegroundColorIndex = newcolor
End If
Next
Next
End With
End If
End If
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub