Excel VBA - Comparing rows in same column

Question

I am new to excel VBA and I have a task I need to complete using VBA. I am looking to compare values in the same column. I want to start the comparison with the last row and move up. The criteria for filtering is if the % difference between the current and last number is greater than 3% then copy and paste the value to another row. Once a value is copied and pasted, values in the data should be compared to the previous copied and pasted value when checking for the 3% difference. Example below. Thanks in advance.

For example if my data range is shown below

1100
1285
1290
3005
1500
2020
2030
2040
2050
2060
2070
2080
2100
2500
3000

This should be my result:

1100
1290 
1500 
2030 
2100 
2500 
3000

The results I have right now have 3005 in there (the difference between 3000 and 3005 is less than 3% percent (3005/3000) thus 3005 should not be in the list), when it should not be in the list.

1100
1290
3005
1500
2030
2100
2500
3000

This is the code I have at the moment. Thanks in advance.

Sub main2()

Dim row_a As Long
Dim row_b As Long
Dim l_2

row_b = Range("D5000").End(xlUp).Row
Cells(row_b, "d").Copy Cells(row_b, "P")

l_2 = row_b - 1

For i = row_b To 3 Step -1
    a = Cells(row_b, "d").Value
    For j = l_2 To 3 Step -1
        If a / Cells(j, "d") <= 0.97 Or a / Cells(j, "d") >= 1.03 Then
            Cells(j, "d").Copy Cells(j, "p")
            a = Cells(j, "d").Value
        End If
    Next j
Next i

End Sub

Answer 1

@Jonathon As I go through your code and found that you need to select value in column "D" as like,

if value is selected then no any value select near by 3% of any selected value

and selection criteria goes from bottom to up which come first take it as you suggested in (3000 an 3005 problem)

and paste all selected value in column "P"

if it correct then go through following code it satisfied your given condition as per question

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Code Start here

Sub Filter3Per()

Dim LastRow As Integer
Dim ComVal As String


'''''''''Apply filter on columun with loop as per criteria
'Read last Row from D column
LastRow = Cells(Rows.Count, "D").End(xlUp).Row

'Clear format color of column D
Range("D:D").Interior.ColorIndex = -4142

'''Clear P column
Range("P:P").ClearContents
'Loop Goes from botttom to top 3 row
For i = LastRow - 1 To 1 Step -1
    'Read compvalue
    ComVal = Cells(i + 1, "D").Value

    'Check for color
    If Cells(i + 1, "D").Interior.ColorIndex <> 3 Then

        'Loop to Check as Criteria
        For j = i To 1 Step -1

        'Critera
        If ComVal / Cells(j, "D") <= 0.97 Or ComVal / Cells(j, "D") >= 1.03 Then

        Else
        Cells(j, "D").Interior.ColorIndex = 3

        End If
        Next

    End If

Next

''''''''Apply filter on columun with loop as per criteria End here
'''''''''''''''Collect value''''''''''''''''''''
'''Clear P column

Range("P:P").ClearContents
For i = 1 To LastRow

    If Cells(i, "D").Interior.ColorIndex <> 3 Then

     Cells(i, "P").Value = Cells(i, "D") 'add value in p Column

    End If
Next
'''''''''''Collect value end here
End Sub

'sub end here '''''