Hello Yasser
I see you have plenty of solutions in the meantime, but just to answer this last small point…
YasserKhalil wrote: ↑17 Apr 2021, 21:11
... the results should have 123 too.
… I mentioned about that already
here …. ( They don’t return you the full string, ( 123 in your example ) , but neither does your main question macro. ( I am sure you can add a bit to include that ). ...................)
I did not do the modifications myself, as I thought you could think of a way to do all that.
For example in
Sub Take3() , you would just add a line to include the full concatenated range number to the dictionary.
To get a concatenation, one way could be to convert the range to a 1 D array ( example by transposing ) , then
Join it with no separator, something like
Dik.Add Key:=Join(Application.Transpose(Your range, ""), …….
Alan
Example applied to my
Sub Take3()
Code: Select all
Sub Take3b() ' https://eileenslounge.com/viewtopic.php?p=283095#p283095
Rem 1 data
Dim Ay() As Variant
Dim Eye As Long, AyeAye As Long, Kay As Long
Let Ay() = Range("Q1").CurrentRegion.Value2
Rem 2 Do It
Dim Dik As Object: Set Dik = CreateObject("Scripting.Dictionary")
For Eye = LBound(Ay(), 1) To UBound(Ay(), 1)
For AyeAye = LBound(Ay(), 1) To UBound(Ay(), 1)
If Ay(Eye, 1) = Ay(AyeAye, 1) Then
Let Kay = Kay + 1
'Let Bea(Kay) = Ay(Eye, 1)
If Not Dik.exists(BubSrt(Ay(Eye, 1))) Then Dik.Add Key:=Ay(Eye, 1), Item:="AnyThong"
Else
Let Kay = Kay + 1
'Let Bea(Kay) = Ay(Eye, 1) & Ay(AyeAye, 1)
If Not Dik.exists(BubSrt(Ay(Eye, 1) & Ay(AyeAye, 1))) Then Dik.Add Key:=Ay(Eye, 1) & Ay(AyeAye, 1), Item:="AnyThong"
End If
Next AyeAye
Next Eye
'Dik.Add Key:=Join(Application.Transpose(Range("Q1").CurrentRegion.Value2), ""), Item:="AnyThong"
Dik.Add Key:=Join(Application.Index(Range("Q1").CurrentRegion.Value2, Evaluate("=Column(A:" & CL(UBound(Range("Q1").CurrentRegion.Value2, 1)) & ")"), Evaluate("=Column(A:" & CL(UBound(Range("Q1").CurrentRegion.Value2, 1)) & ")/Column(A:" & CL(UBound(Range("Q1").CurrentRegion.Value2, 1)) & ")")), ""), Item:="AnyThong"
Dim UnicBea() As Variant: Let UnicBea() = Dik.Keys()
Rem 3 Output
Range("S1:T20").ClearContents
Let Range("T1").Resize(UBound(UnicBea()) + 1, 1).Value2 = Application.Transpose(UnicBea())
Let Range("T1").Resize(UBound(UnicBea()) + 1, 1).Value2 = Application.Index(UnicBea(), Evaluate("=row(1:" & UBound(UnicBea()) + 1 & ")/row(1:" & UBound(UnicBea()) + 1 & ")"), Evaluate("=row(1:" & UBound(UnicBea()) + 1 & ")"))
End Sub
Function BubSrt(ByVal Thong As String) As String
Dim Buf() As String: Let Buf() = Split(StrConv(Thong, vbUnicode), Chr$(0)): ReDim Preserve Buf(UBound(Buf()) - 1) ' https://stackoverflow.com/questions/13195583/split-string-into-array-of-characters
Dim Ey As Long, Jay As Long
Dim Temp As Long
For Ey = LBound(Buf()) To UBound(Buf()) - 1
For Jay = Ey + 1 To UBound(Buf())
If Buf(Ey) > Buf(Jay) Then
Let Temp = Buf(Jay)
Let Buf(Jay) = Buf(Ey)
Let Buf(Ey) = Temp
End If
Next Jay
Next Ey
Let BubSrt = Join(Buf(), "")
End Function
Public Function CL(ByVal lclm As Long) As String ' http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function
Sub transposWonks()
Dim vTemp As Variant, vTempT As Variant
Let vTemp = Range("Q1").CurrentRegion.Value2
Let vTempT = Application.Transpose(vTemp)
Let vTempT = Application.Index(vTemp, Evaluate("=Column(A:C)"), Evaluate("=Column(A:C)/Column(A:C)"))
Let vTempT = Application.Index(vTemp, Evaluate("=Column(A:" & CL(UBound(vTemp, 1)) & ")"), Evaluate("=Column(A:" & CL(UBound(vTemp, 1)) & ")/Column(A:" & CL(UBound(vTemp, 1)) & ")"))
Let vTempT = Application.Index(Range("Q1").CurrentRegion.Value2, Evaluate("=Column(A:" & CL(UBound(Range("Q1").CurrentRegion.Value2, 1)) & ")"), Evaluate("=Column(A:" & CL(UBound(Range("Q1").CurrentRegion.Value2, 1)) & ")/Column(A:" & CL(UBound(Range("Q1").CurrentRegion.Value2, 1)) & ")"))
End Sub
You do not have the required permissions to view the files attached to this post.
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also