VERY SLOW process needs optimization

[mschwent]

I have a table which contains a part number, type of defect, x coordinate, and y coordinate of these defects. I need to make a visualization (similar to a finite element graph) of these a user selected defect overlaid on an image of the part with a user specified resolution.

The way I did this (definitely not the best way) is by making an OLE Excel control with the picture (depending on part type) as a background, setting the size of the rows and columns by the user resolution, converting the x and y coordinates to the resolution, counting the number of defects that appear in each box, and using the conditional formatting of excel to set colors.

My problem is that this process is ridiculously slow. We are expecting to have more or less 1000 defects visualized at a time and about 6400 total squares on the image.

To clarify, here is the code I am currently using:

This subroutine for when the user changes the format parameters:

Private Sub Format_Conditions()

Set_Resolution()
Show_Grid()

With oleEXCEL.ActiveSheet.Cells
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:=txtLow.Value, Formula2:=txtMid.Value
.FormatConditions(1).Font.ColorIndex = 36
.FormatConditions(1).Interior.ColorIndex = 36
.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:=txtMid.Value, Formula2:=txtHigh.Value
.FormatConditions(2).Font.ColorIndex = 44
.FormatConditions(2).Interior.ColorIndex = 44
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
, Formula1:=txtHigh.Value
.FormatConditions(3).Font.ColorIndex = 3
.FormatConditions(3).Interior.ColorIndex = 3
End With

End Sub

And this subroutine for when the user loads a new data set (changes part type, color, etc.)

Private Sub Load_Data_Set()

Dim scale_x, scale_y As Double
Dim row, colum As Integer
Const x_quadros_por_cm = 25
Const y_quadros_por_cm = 25
Const X_ADJ = 70 / 26
Const Y_ADJ = 63 / 17
Dim res As Double
Dim i As Integer
Dim column As String

res = txtResolution.Value
scale_x = (X_ADJ) / (x_quadros_por_cm * res)
scale_y = (Y_ADJ) / (y_quadros_por_cm * res)

Dim l1, l2 As Integer
Dim p1, p2 As String

For i = 0 To lstDATA.ListCount - 1
colum = Int((lstDATA.column(0, i) * scale_x) + 0.49999)
'convert column number to excel letters
l1 = Int(colum / 26)
l2 = colum - (l1 * 26)
If l1 <> 0 Then
p1 = Chr$(l1 + 65)
Else
p1 = NullString
End If
p2 = Chr$(l2 + 65)
row = Int((lstDATA.column(1, i) * scale_y) + 0.49999) + 1

If oleEXCEL.ActiveSheet.Range(p1 & p2 & row).FormulaR1C1 = NullString Then
oleEXCEL.ActiveSheet.Range(p1 & p2 & row).FormulaR1C1 = "=1"
Else
oleEXCEL.ActiveSheet.Range(p1 & p2 & row).FormulaR1C1 = oleEXCEL.ActiveSheet.Range(p1 & p2 & row).FormulaR1C1 & "+1"
End If

' txtX.Value = p1 & p2
' txtY.Value = row
' txtDEFEITO.Value = oleEXCEL.ActiveSheet.Range(p1 & p2 & row).FormulaR1C1
Next i
End Sub

Any help, either optimizing this code or suggesting a new method of doing this, would be appreciated.