Optimizing a Graphical Point Selection and Formatting Macro

Artifex

New Member
Joined
Jul 31, 2007
Messages
1
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)



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
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Forum statistics

Threads
1,181,054
Messages
5,927,855
Members
436,573
Latest member
CMR237

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top