1. ## Extracting unique numbers

I have a spreadsheet that contains account number in Col A with corresdponding numbers in Col B. Some of the account numbers in Col A may appear several times, but the numbers in Col B are unique.

I would like a macro to extract each number once in Col A for eg if 4000 appears several times to extract this once, but to extract all the numbers in Col B relating to this particular number

See Attached Sample Data

2. You should always provide your excel version and tell us what you want the final product to look like. I assume???? that you want number in A and b,c,d,e, to list the col B for each and then delete the col a number. Just a guess.
if desired, send your file to dguillett@gmail.com

BTW, If you did NOT get your other problem that I helped with solved, let me know

3. Thanks for the reply. I am using Excel 2010. Your guess is 100% spot on.

I have managed to resolve the other problem. Thanks for enquiring

4. Should do it
===============
Option Explicit
Dim i As Long
Dim lc As Integer
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i - 1, 1) = Cells(i, 1) Then
lc = Cells(i - 1, Columns.Count).End(xlToLeft).Column + 1
Cells(i - 1, lc).Value = Cells(i, 2).Value
Rows(i).Delete
End If
Next i
Columns.AutoFit
End Sub

5. the -1 and =1 should be at the end of the row up

6. sort first

7. Thanks for the help. We are close to resolving the problem

I have attached three files

1) Extract Files Raw Data
2) Extract files Manual Extraction -this is what the file should look like after extracting the data
3) Extract files after running the macro

8. This will do it. Sort first

Option Explicit
Sub lineemupSAS()
Dim i As Long
Dim lc1 As Integer
Dim lc2 As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1

If Cells(i - 1, 1) = Cells(i, 1) Then
lc1 = Cells(i - 1, Columns.Count).End(xlToLeft).Column + 1
lc2 = Cells(i, Columns.Count).End(xlToLeft).Column
Cells(i, 2).Resize(1, lc2).Copy Cells(i - 1, lc1)
Rows(i).Delete
End If

Next
Columns.AutoFit

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

9. Thanks for the help. Code works perfect

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•