Best way to sort

Suppose I have a list of structural beams.

W6x15
W24x207
W6x15

What I want to accomplish is to have a new list of the beams in descending order of the depth first, W, and then the weight per foot, number after x. My initial attempt was create a main dictionary containing all the W sizes. The W sizes would themselves be a dictionary where each would contain the weight per foot value. So essentially I would have a dictionary with two dictionaries 6 and 24. Dictionary 6 would have items 15 and 207. I figure that for each W dictionary I can write a piece of code that would sort in descending order the weight per foot. Then in the main dictionary I can sort on the W sizes in descending order. Is this a good approach or is there something better I could do?

just create two more columns and split your W6x15 description. one column would contain 6 and the other 15.
then sort on to this two columns.

to convert to numbers, respectively:

first colum:
=VALUE(LEFT(SUBSTITUTE(A2,"W",""),FIND("x",SUBSTITUTE(A2,"W",""))-1))

second column:
=VALUE(MID(A2,FIND("x",A2)+1,99))

Quote:

---

Originally Posted by arnelgp

just create two more columns and split your W6x15 description. one column would contain 6 and the other 15.
then sort on to this two columns.

to convert to numbers, respectively:

first colum:
=VALUE(LEFT(SUBSTITUTE(A2,"W",""),FIND("x",SUBSTITUTE(A2,"W",""))-1))

second column:
=VALUE(MID(A2,FIND("x",A2)+1,99))

---

I failed to mention that I need to do this programmatically due to the program environment I'm in. I am not using Excel. I'm using VBA within another program. I couldn't find a strictly VBA sub forum to put this question in.

i thought it is excel because you post it in Excel forum?
then what VBA program are you using?

Quote:

---

Originally Posted by arnelgp

i thought it is excel because you post it in Excel forum?
then what VBA program are you using?

---

I'm using a CAD program called SolidWorks. I have the ability to write macros to perform automated tasks using VBA. The task at hand is to collect the structural members and sort. Where should I post VBA related questions on this forum? I couldn't find the appropriate location.

Hi Roldy. You can trial this VBA. HTH. Dave

Code:

---

Sub test()Dim Cnt As Integer, Cnt1 As Integer, Cnt2 As Integer, Rng As Range
Dim Lastrow As Integer, NameArr() As Variant, Cnter As Integer
Dim TempStr As String, Splitter As Variant, Depth As Double
'Data in "A1"A" & etc)
'Depth output in "C"; Wt/ft in "D"
With Sheets("Sheet1")
    Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
'sort unique into array
For Cnt = 1 To Lastrow
For Cnt1 = 1 To (Cnt - 1)
If LCase(.Range("A" & Cnt1).Value) = _
    LCase(.Range("A" & Cnt).Value) Then ' more than one entry
GoTo Bart
End If
Next Cnt1
Cnter = Cnter + 1
ReDim Preserve NameArr(Cnter)
NameArr(Cnter - 1) = .Range("A" & Cnt).Value
Bart:
Next Cnt
On Error GoTo ErFix
Application.ScreenUpdating = False
'loop unique arr & split into depth("C") and wt/ft("D")
For Cnt2 = LBound(NameArr) To UBound(NameArr) - 1
TempStr = NameArr(Cnt2) & "x"
Splitter = Split(TempStr, "x")
Depth = CDbl(Right(Splitter(0), Len(Splitter(0)) - 1))
.Range("C" & Cnt2 + 1).Value = Depth
.Range("D" & Cnt2 + 1).Value = Splitter(1) 'wt/ft
Next Cnt2
'sort descending
Set Rng = .Range(.Cells(1, "C"), .Cells(Lastrow, "D"))
Rng.Sort Key1:=Range("C1"), Order1:=xlDescending, _
                    Orientation:=xlSortColumns
'Add "W" to depth
For Cnt2 = LBound(NameArr) To UBound(NameArr) - 1
.Range("C" & Cnt2 + 1).Value = "W" & .Range("C" & Cnt2 + 1).Value
Next Cnt2
End With
ErFix:
Application.ScreenUpdating = True
End Sub

---

Quote:

---

Originally Posted by Dave

Hi Roldy. You can trial this VBA. HTH. Dave

Code:

---

Sub test()Dim Cnt As Integer, Cnt1 As Integer, Cnt2 As Integer, Rng As Range
Dim Lastrow As Integer, NameArr() As Variant, Cnter As Integer
Dim TempStr As String, Splitter As Variant, Depth As Double
'Data in "A1"A" & etc)
'Depth output in "C"; Wt/ft in "D"
With Sheets("Sheet1")
    Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
'sort unique into array
For Cnt = 1 To Lastrow
For Cnt1 = 1 To (Cnt - 1)
If LCase(.Range("A" & Cnt1).Value) = _
    LCase(.Range("A" & Cnt).Value) Then ' more than one entry
GoTo Bart
End If
Next Cnt1
Cnter = Cnter + 1
ReDim Preserve NameArr(Cnter)
NameArr(Cnter - 1) = .Range("A" & Cnt).Value
Bart:
Next Cnt
On Error GoTo ErFix
Application.ScreenUpdating = False
'loop unique arr & split into depth("C") and wt/ft("D")
For Cnt2 = LBound(NameArr) To UBound(NameArr) - 1
TempStr = NameArr(Cnt2) & "x"
Splitter = Split(TempStr, "x")
Depth = CDbl(Right(Splitter(0), Len(Splitter(0)) - 1))
.Range("C" & Cnt2 + 1).Value = Depth
.Range("D" & Cnt2 + 1).Value = Splitter(1) 'wt/ft
Next Cnt2
'sort descending
Set Rng = .Range(.Cells(1, "C"), .Cells(Lastrow, "D"))
Rng.Sort Key1:=Range("C1"), Order1:=xlDescending, _
                    Orientation:=xlSortColumns
'Add "W" to depth
For Cnt2 = LBound(NameArr) To UBound(NameArr) - 1
.Range("C" & Cnt2 + 1).Value = "W" & .Range("C" & Cnt2 + 1).Value
Next Cnt2
End With
ErFix:
Application.ScreenUpdating = True
End Sub

---

---

I've decided on using a dictionary to store a class objects. Each class object defines a structural member. For example, a class object for a W6 x 25 beam would look something like this:
size1 = 6
size2 = 25
size3 = 0
vweldSize = "W6 X 25"
vweldType = "W Section"

When my code gathers up all the structural members, it also creates a collection of the unique types in my file; W Section, L Angle, C Channel, etc.

For each memberType in the memberType collection I look at every gathered member and put those into a temporary collection. After this temporary collection is created, it contains all the members of type "W Section" for example. I then need to sort this collection based on the class objects size1 then by size2 and by size3. This last part is where I'm a little stuck.

My solution is as follows for the temporary collection sorting:

Code:

---

        For icounter1 = 1 To tempColl.Count - 1            For icounter2 = icounter1 + 1 To tempColl.Count
                If tempColl(icounter1).size1 <= tempColl(icounter2).size1 Then
                    If tempColl(icounter1).size2 <= tempColl(icounter2).size2 Then
                        Set tempItem = tempColl(icounter2)
                        tempColl.Remove icounter2
                        tempColl.Add tempItem, , icounter1
                    End If
                End If
            Next icounter2
        Next icounter1

---

This doesn't have a check for comparing size3's but it shouldn't be any different logic.