I have a list of data, which is coded by a number following a decimal point for each entry. I need to decode the data and have it tabulated by the code, with each entry listed in an order. Is this possible? See an example below....
Data I have:
12.11
15.12
17.44
19.12
25.11
What I want (ignore the dashes!):
.11 .12 .44
12
-----15
---------17
-----19
25
I have 11 different codes, and usually about 400 entried in a data column.
The macro below is what I am working with now, but it lists everything without spaces between, such that that the above data would look like?
This macro gives me (again, ignore the dashes!):
.11 .12 .44
12--15--17
25--19
The macro:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com
fficeffice" /><o
></o>
Dim Rng As Range<o></o>
Dim Dn As Range<o></o>
Dim n AsLong<o></o>
Dim Q As Variant<o></o>
Dim oMax AsLong<o></o>
If Target.Count = 1 And Target.Address(0, 0) = "A1" Then<o></o>
Set Rng = Range(Range("C7"), Range("c" & Rows.Count).End(xlUp))<o></o>
ReDim Ray(1 To Rng.Count, 1 To 11)<o></o>
With CreateObject("scripting.dictionary")<o></o>
.CompareMode = vbTextCompare<o></o>
ForEach Dn In Rng<o></o>
If Not .Exists(Dn.Value) Then<o></o>
n = n + 1<o></o>
.Add Dn.Value, Array(n, 2)<o></o>
Ray(1, n) = Dn.Value<o></o>
Ray(2, n) = Dn.Offset(, -1)<o></o>
Else<o></o>
Q = .Item(Dn.Value)<o></o>
Q(1) = Q(1) + 1<o></o>
Ray(Q(1), Q(0)) = Dn.Offset(, -1)<o></o>
oMax = Application.Max(Q(1), oMax)<o></o>
.Item(Dn.Value) = Q<o></o>
End If<o></o>
Next<o></o>
Range("E1").Resize(oMax, 11) = Ray<o></o>
End With<o></o>
End If<o></o>
EndSub<o></o>
Data I have:
12.11
15.12
17.44
19.12
25.11
What I want (ignore the dashes!):
.11 .12 .44
12
-----15
---------17
-----19
25
I have 11 different codes, and usually about 400 entried in a data column.
The macro below is what I am working with now, but it lists everything without spaces between, such that that the above data would look like?
This macro gives me (again, ignore the dashes!):
.11 .12 .44
12--15--17
25--19
The macro:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com
fficeffice" /><o></o>Dim Rng As Range<o
></o>Dim Dn As Range<o
></o>Dim n AsLong<o
></o>Dim Q As Variant<o
></o>Dim oMax AsLong<o
></o>If Target.Count = 1 And Target.Address(0, 0) = "A1" Then<o
></o>Set Rng = Range(Range("C7"), Range("c" & Rows.Count).End(xlUp))<o
></o>ReDim Ray(1 To Rng.Count, 1 To 11)<o
></o>With CreateObject("scripting.dictionary")<o
></o>.CompareMode = vbTextCompare<o
></o>ForEach Dn In Rng<o
></o>If Not .Exists(Dn.Value) Then<o
></o>n = n + 1<o
></o>.Add Dn.Value, Array(n, 2)<o
></o>Ray(1, n) = Dn.Value<o
></o>Ray(2, n) = Dn.Offset(, -1)<o
></o>Else<o
></o>Q = .Item(Dn.Value)<o
></o>Q(1) = Q(1) + 1<o
></o>Ray(Q(1), Q(0)) = Dn.Offset(, -1)<o
></o>oMax = Application.Max(Q(1), oMax)<o
></o>.Item(Dn.Value) = Q<o
></o>End If<o
></o>Next<o
></o>Range("E1").Resize(oMax, 11) = Ray<o
></o>End With<o
></o>End If<o
></o>EndSub<o
></o>
Last edited:
