VBA: Streamlining Code...Or Better Way

[darkdimension]

The idea here is to take two data columns, combine them into one column, drag each 1st item through list looking for match...then second match...then comparison and replace with largest third element. (Specifically, a way to sort for the lowest elevation of data points to create bottom surface in ACAD.)

The code appears to work for a small set of data points but for the larger set (> 20,000 entries), not so good.

Any suggestions are welcomed.

This is a work in progress. I am aware that I have declared variables I do not need and never use. Needed something fast, so, not the most efficient code - hence, why I am asking for suggestions.

Private Sub Button4_Click()

Dim CompareToRange_E As Variant, CompareToRange_N As Variant, CompareToRange_EL As Variant, _
    CompareToRange_Total As Variant, _
    To_Be_Compared_E As Variant, To_Be_Compared_N, To_Be_Compared_EL As Variant, _
    x As Variant, y As Variant

str1 = InputBox("Enter Column Name to which To Be Compared - EASTING")
str2 = InputBox("Enter Column Name to which To Be Compared - NORTHING")
str3 = InputBox("Enter Column Name to which To Be Compared - Elevation")
str4 = InputBox("Enter Column Name to which Compare to - EASTING")
str5 = InputBox("Enter Column Name to which Compare to - NORTHING")
str6 = InputBox("Enter Column Name to which Compare To - Elevation")
str7 = InputBox("Enter Column Name to place the Result")
If str7 = vbNullString Then Exit Sub

Application.ScreenUpdating = False

Range(str1 & "1").Select
Selection.End(xlDown).Select
Set To_Be_Compared_E = Range(str1 & "1:" & Selection.Address)

Range(str2 & "1").Select
Selection.End(xlDown).Select
Set To_Be_Compared_N = Range(str2 & "1:" & Selection.Address)

Range(str3 & "1").Select
Selection.End(xlDown).Select
Set To_Be_Compared_EL = Range(str3 & "1:" & Selection.Address)

Range(str4 & "1").Select
Selection.End(xlDown).Select
Set CompareToRange_E = Range(str4 & "1:" & Selection.Address)

Range(str5 & "1").Select
Selection.End(xlDown).Select
Set CompareToRange_N = Range(str5 & "1:" & Selection.Address)

Range(str6 & "1").Select
Selection.End(xlDown).Select
Set CompareToRange_EL = Range(str6 & "1:" & Selection.Address)

To_Be_Compared_E.Select
Selection.Copy
Range(str7 & "1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

To_Be_Compared_N.Select
Selection.Copy
Range(str7 & "1").Offset(0, 1).Select
ActiveSheet.Paste

Application.CutCopyMode = False

To_Be_Compared_EL.Select
Selection.Copy
Range(str7 & "1").Offset(0, 2).Select
ActiveSheet.Paste

Application.CutCopyMode = False

CompareToRange_E.Select
Selection.Copy
Range(str7 & "65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste

Application.CutCopyMode = False

CompareToRange_N.Select
Selection.Copy
Range(str7 & "65536").Offset(0, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste

Application.CutCopyMode = False

CompareToRange_EL.Select
Selection.Copy
Range(str7 & "65536").Offset(0, 2).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste

Application.CutCopyMode = False

Range(str7 & "1").Select
Selection.End(xlDown).Select
Set CompareToRange_Total = Range(str7 & "1:" & Selection.Address)

To_Be_Compared_E.Select

i = 1

    For Each x In Selection
    
        j = 1
        
        
        For Each y In CompareToRange_Total
            If x = y Then
                
                If Range(str2 & i).Value = Range(str7 & j).Offset(0, 1).Value Then
                
                    If Range(str3 & i).Value > Range(str7 & j).Offset(0, 2).Value Then
                        Range(str7 & j).Offset(0, 1).Value = _
                            Range(str2 & i).Value
                        Range(str7 & j).Offset(0, 2).Value = _
                            Range(str3 & i).Value
                    End If
                    
                End If
                    
            End If
            
            j = j + 1
        Next y
            
        i = i + 1
            
    Next x
    
Application.CutCopyMode = False
    
CompareToRange_E.Select

i = 1

    For Each x In Selection
    
        j = 1
        
        
        For Each y In CompareToRange_Total
            If x = y Then
                
                If Range(str5 & i).Value = Range(str7 & j).Offset(0, 1).Value Then
                
                    If Range(str6 & i).Value > Range(str7 & j).Offset(0, 2).Value Then
                        Range(str7 & j).Offset(0, 1).Value = _
                            Range(str5 & i).Value
                        Range(str7 & j).Offset(0, 2).Value = _
                            Range(str6 & i).Value
                    End If
                    
                End If
                    
            End If
            
            j = j + 1
        Next y
            
        i = i + 1
            
    Next x
    
Application.ScreenUpdating = True
    
End Sub