Delete Repeating name and put all data in 1 row

[Nandan]

Dear all

I have 3 column

Name DayofApr SalofApr DaysoMay SasOfMay DaysOfJun SalofJun
X 25 15000
X 30 20000
X 15 10000

i want output like this

Name DayofApr SalofApr DaysoMay SasOfMay DaysOfJun SalofJun
X 25 15000 15 10000 30 20000

Can anybody help me

Thaks & REgards

Nandan

 

[Marcelo Branco]

Hi,

Assuming your data in columns A B C (headers in row 1) and sorted by names in column A, maybe this
Adjust the sheet-name in the first line 0f code after the Dims

(try it on a test-workbook)

Sub arrangeData()
    'Thread 547698
    Dim wk As Worksheet
    Dim lastRow As Long, i As Long, lin As Long, col As Long
 
    Set wk = Sheets("Plan1")
 
    With wk
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
 
        'Move data
        For i = 2 To lastRow
            If .Range("A" & i).Value <> .Range("A" & i - 1) Then
                lin = i
                col = 0
            Else
                col = col + 2
                .Range("A" & lin).Offset(0, col + 1) = .Range("A" & i).Offset(0, 1)
                .Range("A" & lin).Offset(0, col + 2) = .Range("A" & i).Offset(0, 2)
            End If
        Next i
 
        'Delete rows
        For i = lastRow To 2 Step -1
            If .Range("A" & i).Value = .Range("A" & i - 1).Value Then
                .Rows(i).EntireRow.Delete
            End If
        Next i
    End With
 
End Sub

HTH

M.