CODEWITHSUNDEEP
excelvba
abraham foto
abraham foto

Reputation: 457

how can i copy and paste only the unique values in vba?

i am trying to copy and paste unique values of a column in vba. the challenges are the: the excel doesn't have a fixed position, the position can change based on the data. As can be seen in the picture, i want to take the unique values of the amount(abs) of Columns A and paste then besides it on columns B, i don't want to touch the amounts in column A. there are a couple of empty cells between amount and absolute amount. both amount and absolute amounts are dynamic.

enter image [description]1 here

As i mentioned above, the tables are dynamic. if the number of amount gets bigger the amount adds a new row and the amount(abs) always keeps the two empty cells between. Any suggestions help is apperciated?

Upvotes: 0

Views: 6355

Answers (2)

HTH
HTH

Reputation: 2031

you could use RemoveDuplicates() method of Range object:

Sub Test()
    With Worksheets("MySheetName") ' change "MySheetName" to your actual sheet name
        With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
            With .Range(.Find(What:="Amount(ABS)", LookIn:=xlValues, LookAt:=xlWhole).Offset(1), .Cells(.Count))
                .Offset(, 1).Value = .Value
                .Offset(1).RemoveDuplicates Columns:=1, Header:=xlNo
            End With
        End With
    End With
End Sub

Upvotes: 1

urdearboy
urdearboy

Reputation: 14580

If you have access to the UNIQUE function in excel:

  1. Determine your range of ABS Amounts using the defined variables Found and lr
  2. Output the UNIQUE function to the right to de-dup your range
  3. Clear the formula/spill range with a value transfer (Range.Value = Range.Value)
Sub Social_Distance()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet2") '<-- Update Sheet Name
Dim Found As Range, lr As Long

lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set Found = ws.Range("A1:A" & lr).Find(What:="Amount(ABS)", LookIn:=xlValues, LookAt:=xlWhole)

If Not Found Is Nothing Then

    Found.Offset(, 1) = "Unique Values"
    Found.Offset(1, 1) = "=UNIQUE(" & ws.Range(ws.Cells(Found.Offset(1).Row, 1), ws.Cells(lr, 1)).Address(False, False) & ")"

    ws.Range(ws.Cells(Found.Offset(1).Row, 2), ws.Cells(lr, 2)).Value = ws.Range(ws.Cells(Found.Offset(1).Row, 2), ws.Cells(lr, 2)).Value

End If

End Sub

Upvotes: 0

Related Questions