Sorting Excel data

[soumen21]

Hi Experts,

I have a list of data in this pattern

I want to sort it in the following way.

Could you please help?

Best Regards

 

[hagia_sofia]

Which version of Excel are you using?

 

[kvsrinivasamurthy]

Does VBA solution ok.

 

[soumen21]

Microsoft Office 365
VBA solution ok

 

[kvsrinivasamurthy]

Pl post the sample in XL2BB format.

 

[hagia_sofia]

Not sure if this is going to work but please test it:

=LET(
array1,D1:D10,
array2,B1:D10,
array3,A1:B10,
non,--(NOT(ISBLANK(array1))),
a,IF(non=1,array2,""),
b,DROP(REDUCE("",SEQUENCE(3),LAMBDA(c,d,HSTACK(c,SCAN("",CHOOSECOLS(a,d),LAMBDA(a,b,IF(b<>"",b,a)))))),,1),
c,CHOOSECOLS(FILTER(b,non=0),1,3,2),
d,CHOOSECOLS(FILTER(array3,non=0),2,1),
HSTACK(c,d))

 

[kvsrinivasamurthy]

Data : Sheet1, A2:D10
Output: Sheet2, A2:E9
Macro code:

Sub RearrangeData()
Dim A
'Dim K(1 To 3)
Dim T&, Ro&
A = Sheets("Sheet1").Range("A2").CurrentRegion
ReDim B(1 To UBound(A, 1), 1 To 5)
For T = 1 To UBound(A, 1) - 1
If A(T, 4) <> "" Then
ReDim K(1 To 3)
K(1) = A(T, 2): K(2) = A(T, 4): K(3) = A(T, 3)
Else
Ro = Ro + 1
B(Ro, 1) = K(1): B(Ro, 2) = K(2): B(Ro, 3) = K(3): B(Ro, 4) = A(T, 2): B(Ro, 5) = A(T, 1)
End If
Next T

With Sheets("Sheet2")
.Range("A2").Clear
.Range("A2").Resize(Ro, 5) = B
End With

End Sub

 

[kvsrinivasamurthy]

Slight mistake was there. Corrected Macro code:

Sub RearrangeData()
Dim A
'Dim K(1 To 3)
Dim T&, Ro&
A = Sheets("Sheet1").Range("A2").CurrentRegion
ReDim B(1 To UBound(A, 1), 1 To 5)
For T = 1 To UBound(A, 1)
If A(T, 4) <> "" Then
ReDim K(1 To 3)
K(1) = A(T, 2): K(2) = A(T, 4): K(3) = A(T, 3)
Else
Ro = Ro + 1
B(Ro, 1) = K(1): B(Ro, 2) = K(2): B(Ro, 3) = K(3): B(Ro, 4) = A(T, 2): B(Ro, 5) = A(T, 1)
End If
Next T

With Sheets("Sheet2")
.Range("A2").Clear
.Range("A2").Resize(Ro, 5) = B
End With

End Sub