VBA Excel macro - display cell values which are column related

Question

I need to get unique values from column P and display them in the column Q (so far i know how to do that):

s1.Range("P2:P").RemoveDuplicates Columns:=1, Header:=x3No

But i can't figure out how to display values ( column O ) of those id's into the column R . Duplicate id's have the same values. That each unique id would have only one value. Could anyone help me a bit?

Thanks!

Answer 1

Maybe this:

Sub test()

Dim s1 As Worksheet
Set s1 = Worksheets("Sheet1")

Dim lrow As Long
Dim i As Long

s1.Range("O2:R100").RemoveDuplicates Columns:=2, Header:=xlYes 'remove duplicates from column 2 in range O2:R100

lrow = s1.Cells(Rows.Count, 16).End(xlUp).Row 'Find last row.

For i = 2 To lrow
    Cells(i, 18).Value = Cells(i, 16).Value 'Copy values
Next i
End Sub

---

Instead of removing the previous values from the column O and PI would just fill the unique id and value columns with unique values.

Sub test()

Dim unique()
Dim ct As Long
Dim s1 As Worksheet
Dim lrow As Long
Dim x As Long
Dim y As Long

Set s1 = Worksheets("Sheet1")

ReDim unique(s1.Cells(s1.Rows.Count, 16).End(xlUp).Row)

lrow = s1.Cells(Rows.Count, 17).End(xlUp).Row + 1 'Find first row to fill with unique values


For x = 2 To s1.Cells(s1.Rows.Count, 16).End(xlUp).Row 'Column to check for unique values
    If CountIfArray(ActiveSheet.Cells(x, 16), unique()) = 0 Then 'Build array to store unique values.
        unique(ct) = ActiveSheet.Cells(x, 16).Text 'Populate the array
        Cells(lrow, 17).Value = Cells(x, 16).Value 'Copy column P to Q
        Cells(lrow, 18).Value = Cells(x, 15).Value  'Copy column O to R
        lrow = lrow + 1
        ct = ct + 1 
    End If
Next x
End Sub

Public Function CountIfArray(lookup_val As String, lookup_arr As Variant)
CountIfArray = Application.Count(Application.Match(lookup_val, lookup_arr, 0))
End Function