Help editing this macro so it will only use amount of cells it needs for the result

[strat919]

I have to set the range on this macro before I run it. If it would only create the amount of cells needed to complete the macro. It works well and will give results to multiple sheets, sometimes I'm getting millions of results that exceeds the row limitations. If I set it to Const maximum = 1048576 to handle any situation, it creates so many rows if not needed, and is hard to work with if I'm working with a smaller amount of rows. Thanks

Public Sub GetUniquePairs()
    Application.ScreenUpdating = False
    Const maximum = 1048576
    Dim lastRow As Long, thisRow As Long
    Dim i As Long, j As Long
    Dim ws As Worksheet, Results As Worksheet
    Dim Res(1 To maximum, 1 To 1) As Variant
    
    Set ws = ActiveSheet
    Set Results = Sheets.Add
    lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    thisRow = 1
    
    For i = 1 To lastRow - 1
        For j = i + 1 To lastRow
            c = c + 1
            Res(thisRow, 1) = ws.Cells(i, 1).Value & "," & ws.Cells(j, 1).Value
            thisRow = thisRow + 1
                If thisRow = maximum Then
                    thisRow = 1
                    Results.Cells(1, 1).Resize(maximum).Value = Res
                    Erase Res
                    Set Results = Sheets.Add
                End If
                If i = lastRow - 1 Then
                    Results.Cells(1, 1).Resize(maximum).Value = Res
                    Erase Res
                End If
        Next j
    Next i
End Sub

 

[Yongle]

What is the calculation required to determine "the amount of cells needed" ?
- it is a function of the number of cells with coordinate values in column A
- provide VBA with that calculation


Replace

Const maximum

with

Dim maximum As Long

And then ...

maximum = result of above calculation

unless it exceeds 1048576
So ....

maximum = WorksheetFunction.Min(1048576, result of above calculation)

 

[strat919]

Thank you Yongle......I'll give that a try