Re-Arrange Data based on FLAG

[justdream]

Dears,

how to automatically Re-Arrange all Data in Input based on Flag (Type) to be as in Output


Input



Output


Flag Name
Type



Flag Name
Type


(A1A)1
Normal






(A1A)1
(A1A)2


(A1A)2
Normal






(A1A)1
(A1A)3


(A1A)3
Normal






(A1A)2
(A1A)1


(B2B)1
Special



(A1A)2
(A1A)3


(B2B)2
Special



(A1A)3
(A1A)1


(B2B)3
Special



(A1A)3
(A1A)2







(B2B)1
(B2B)1







(B2B)1
(B2B)2







(B2B)1
(B2B)3







(B2B)2
(B2B)1







(B2B)2
(B2B)2







(B2B)2
(B2B)3







(B2B)3
(B2B)1







(B2B)3
(B2B)2







(B2B)3
(B2B)3


Idea of my output:
if Type is normal so (A1A) will be connected to all its family (1 is with 2 & 3) (2 with 1 & 3) and (3 with 1 & 2)
if Type is Special so (B1B) will be connected to all its family Plus itself (1 is with 1 & 2 & 3) (2 with 2 & 1 & 3) and (3 with 3 & 1 & 2)

Your immediate support it highly appreciated

[justdream]

Dears,
could you help me please

[snb]

What do you mean by 'immediate' ?

[justdream]

it's urgent issue for me (time is critical), your help will be highly appreciated
of course, it's not obligation..
Sorry for any misunderstanding

[Teeroy]

I've assumed that the Name data begins in A1 (and is not sorted), Type in B1. Try the following and let me know if it work for you.


Sub SortByFlagType()
Dim oDict As Object
Dim rCell As Range, rData As Range, rOutput As Range
Dim sTerm1 As String, sFlagMatch
Set oDict = CreateObject("scripting.Dictionary")
Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)).Copy Range("E1")
Set rData = Range(Range("E1"), Range("E" & Rows.Count).End(xlUp))
rData.Sort Key1:=Range("E1"), Order1:=xlAscending
For Each rCell In rData
If Not oDict.exists(rCell.Value) Then
oDict.Add rCell.Value, rCell.Offset(0, -3).Value
End If
Next
rData.ClearContents
Set rOutput = Range("E1")
For Each key In oDict
sTerm1 = Left(key, InStr(key, ")"))
For Each sFlagMatch In oDict
If oDict(key) = "Normal" Then
If InStr(sFlagMatch, sTerm1) > 0 And key <> sFlagMatch Then
rOutput = key
rOutput.Offset(0, 1) = sFlagMatch
Set rOutput = rOutput.Offset(1, 0)
End If
Else
If InStr(sFlagMatch, sTerm1) > 0 Then
rOutput = key
rOutput.Offset(0, 1) = sFlagMatch
Set rOutput = rOutput.Offset(1, 0)
End If
End If
Next
Next
End Sub

[shrivallabha]

Here's a formula based way which requires one helper column. For larger dataset, VBA will be the way to go as formula might slow down things.

I have attached worked out example as I may not be able explain the setup directly.

[snb]

or:


Sub M_snb()
sn = Cells(1).CurrentRegion
sp = Application.Transpose(Cells(1).CurrentRegion.Resize(, 1))

For j = 1 To UBound(sn)
c00 = c00 & Replace(IIf(sn(j, 2) = "Normal", "|", "_") & Join(Filter(sp, Left(sn(j, 1), 5)), "_"), "_", "|" & sn(j, 1) & "_")
Next

sn = Filter(Split(c00, "|"), "_")
Cells(1, 6).Resize(UBound(sn) + 1) = Application.Transpose(sn)
End Sub