Error 6 - Overflow. What now?

I'm completely new to VBA and don't know very little programming in general.

I am trying to run this VBA:

hxxps : //github.com/niko86/RamerDouglasPeucker-ExcelVBA

(not allowed to post live links)

However I am getting an Error 6 - Overflow, and if I press Debug it points to this line:

rowCount = UBound(pointList)

Unfortunately I have no idea how to proceed from here. I've looked at the MS docs for both Error 6 and for the UBound function, but it's not been very fruitful.

Any help would be appreciated.



-----------
Why am I trying to run this VBA? Well, I have a dataset with about 12000 datapoints. I need to graph this. But my computer is not really powerful enough to do so smoothly. So I was hoping to reduce the number of data points to about 1000. I don't need the graph to be accurate. It just needs to "look" similar enough. I'm trying to graph in GraphPad Prism. Not excel btw.

Hi there,

It's VERY difficult to make meaningful suggestions without seeing the full code (which I can't access using the link you posted).

The "Overflow" error means that a variable is being asked to store a value which exceeds the allowable limits for the type of variable.

If your rowCount variable is declared (in a Dim statement) as being of type Integer, it might be worth declaring it to be of type Long and seeing if that makes a difference.

Hope this helps.

Regards,

Greg M

Awesome! Thank you both That cleared that problem. But now I have a new error.

Error 13 - Type Mismatch. It points to this line.

epsilon = Sheets("Sheet1").Range("epsilon")

In the instructions to use this VBA it says you need to define a range in your excel book and name it epsilon. I'm not entirely sure I've done that the correct way. Maybe that is what is giving me this error? How does VBA want you to define a range anyway?

Hi again,

Thanks for posting your code.

The "Type Mismatch" error is generated when a variable of type (e.g.) Long is passed to a routine in which the corresponding dummy argument is declared to be of type (e.g.) Integer.

I've changed various declarations in your code to achieve consistency. Please note that I haven't attempted to understand what your code does, I've just got it to compile successfully.

The modified code is as follows:

Option Explicit


Sub CallDouglasPeucker()

Dim pointList As Variant
Dim rowCount As Long
Dim result As Variant
Dim epsilon As Double

Call ClearOutput
    
    pointList = Sheets("Sheet1").Range("Table1")
    
    rowCount = UBound(pointList)
    
    epsilon = Sheets("Sheet1").Range("epsilon")
    
    result = DouglasPeucker(pointList, epsilon, rowCount)
    
    WriteResult (result)

End Sub


Function DouglasPeucker(pointList As Variant, epsilon As Double, rowCount As Long) As Variant

    Dim dMax As Double
    Dim Index As Long
    Dim d As Double
    Dim arrResults1 As Variant
    Dim arrResults2 As Variant
    Dim resultList As Variant
    Dim recResults1 As Variant
    Dim recResults2 As Variant
    Dim i As Long
    
    ' Find the point with the maximum distance
    dMax = 0
    Index = 0
    
    For i = 2 To (rowCount)
        d = Abs((pointList(rowCount, 1) - pointList(1, 1)) * (pointList(1, 2) - pointList(i, 2)) - (pointList(1, 1) - pointList(i, 1)) * (pointList(rowCount, 2) - pointList(1, 2))) / Sqr((pointList(rowCount, 1) - pointList(1, 1)) ^ 2 + (pointList(rowCount, 2) - pointList(1, 2)) ^ 2)
        If d > dMax Then
            Index = i
            dMax = d
        End If
    Next i
    
    'Testing if can stop cut going to index 0
    If Index > 1 Then
        arrResults1 = Cut_Array(pointList, 1, Index)
        arrResults2 = Cut_Array(pointList, Index, rowCount)
        
        ' If max distance is greater than epsilon, recursively simplify
        If (dMax > epsilon) Then
            ' Recursive call
            recResults1 = DouglasPeucker(arrResults1, epsilon, UBound(arrResults1))
            recResults2 = DouglasPeucker(arrResults2, epsilon, UBound(arrResults2))
    
            ' Build the result list
            resultList = Join_Array(recResults1, recResults2)
        Else
            ReDim resultList(1 To 2, 1 To 2)
            
            resultList(1, 1) = pointList(1, 1)
            resultList(1, 2) = pointList(1, 2)
            resultList(2, 1) = pointList(rowCount, 1)
            resultList(2, 2) = pointList(rowCount, 2)
        End If
    Else
        resultList = pointList
    End If

    ' Return the result
    DouglasPeucker = resultList

End Function


Function Cut_Array(arr As Variant, arrStart As Long, arrEnd As Long) As Variant
    
    Dim resultList As Variant
    Dim i As Long
    Dim j As Long

    ReDim resultList(1 To (arrEnd - arrStart) + 1, 1 To 2)
    
    For i = arrStart To arrEnd
        For j = 1 To 2
            resultList((i - arrStart) + 1, j) = arr(i, j)
        Next j
    Next i
    
    Cut_Array = resultList
        
End Function


Function Join_Array(arr1 As Variant, arr2 As Variant) As Variant

    Dim resultList As Variant
    Dim arr1Length As Integer
    Dim arr2Length As Integer
    Dim newArrLength As Long
    Dim i As Long
    Dim j As Long

    arr1Length = UBound(arr1) - 1
    arr2Length = UBound(arr2)
    
    newArrLength = arr1Length + arr2Length
    
    ReDim resultList(1 To newArrLength, 1 To 2)
    
    For i = 1 To arr1Length
        For j = 1 To 2
          resultList(i, j) = arr1(i, j)
        Next j
    Next i
    
    For i = 1 To arr2Length
        For j = 1 To 2
          resultList(i + arr1Length, j) = arr2(i, j)
        Next j
    Next i
    
    Join_Array = resultList
    
End Function


Sub WriteResult(result As Variant)
        
    Dim Table2 As ListObject
    Dim i As Long
    Dim j As Long

    Set Table2 = Sheets("Sheet2").ListObjects("Table2")

    'Copy information loop
    For i = 1 To UBound(result)
        For j = 1 To UBound(result, 2)
            Table2.Range.Cells(i + 1, j).Value = result(i, j)
        Next j
    Next i
    
End Sub


Sub ClearOutput()

    Dim OutputTable As ListObject
    Dim StartRow As Integer
    
    Set OutputTable = Sheets("Sheet2").ListObjects("Table2")
    
    StartRow = OutputTable.Range.Cells(1, 1).Row + 1
    If Not OutputTable.InsertRowRange Is Nothing Then
        'Pass
    Else
        Sheets("Sheet2").Rows(StartRow & ":" & (OutputTable.DataBodyRange.Rows.Count + StartRow)).Delete
    End If
    
End Sub

Hope this helps.

Regards,

Greg M

Originally Posted by rorya

It needs to be a one cell range with a number in it - is it?

Currently it is not. I am working from the assumption that epsilon is the target number for the macro, I want to reduce my data to 1000, so I tried creating a range that spans a 1000 cells. Probably not the way to do it eh?

Hi again,

You don't need to define a named range using VBA - you can do it, but it's probably a bit easier to do it in "native" Excel.

On the Ribbon, click on FORMULAS >> Name Manager, and specify the name ("epsilon") of the range, and the range of cells to which you want that name to be applied.

Hope this helps.

Regards,

Greg M

Originally Posted by Greg M

Hi again,

You don't need to define a named range using VBA - you can do it, but it's probably a bit easier to do it in "native" Excel.

On the Ribbon, click on FORMULAS >> Name Manager, and specify the name ("epsilon") of the range, and the range of cells to which you want that name to be applied.

Hope this helps.

Regards,

Greg M

That solved it. Now it runs as intended. Thank you so much!!

If "epsilon" is declared as a Range, the "Type Mismatch" error you indicated can be avoided by using:

Set epsilon = Sheets("Sheet1").Range("epsilon")

Regards,

Greg M

Hi again,

Many thanks for all of your feedback.

You're welcome - glad I was able to help.

Regards,

Greg M