If you have data in Excel Sheet like :
Application.screenUpdating=false
Sub CreateList()
Dim rngRange As Range
Dim rngCell As Range
Dim rngCell2 As Range
Dim bytCol As Byte
Set rngRange = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
rngRange.Copy Range("C1")
Range("A:B").Sort key1:=Range("A1")
Range("C:C").RemoveDuplicates 1
bytCol = 1
For Each rngCell In Range("C1:C" & Range("C" & Rows.Count).End(xlUp).Row)
For Each rngCell2 In rngRange
If rngCell2.Value = rngCell.Value Then
rngCell.Offset(0, bytCol).Value = rngCell2.Offset(0, 1).Value
bytCol = bytCol + 1
End If
Next rngCell2
bytCol = 1
Next rngCell
Application.screenUpdating=True
End Sub
Application.screenUpdating=false
Sub CreateList()
Dim rngRange As Range
Dim rngCell As Range
Dim rngCell2 As Range
Dim bytCol As Byte
Set rngRange = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
rngRange.Copy Range("C1")
Range("A:B").Sort key1:=Range("A1")
Range("C:C").RemoveDuplicates 1
bytCol = 1
For Each rngCell In Range("C1:C" & Range("C" & Rows.Count).End(xlUp).Row)
For Each rngCell2 In rngRange
If rngCell2.Value = rngCell.Value Then
rngCell.Offset(0, bytCol).Value = rngCell2.Offset(0, 1).Value
bytCol = bytCol + 1
End If
Next rngCell2
bytCol = 1
Next rngCell
Application.screenUpdating=True
End Sub
You can transpose this Data in this Way By using Mention Code:
No comments:
Post a Comment