Hey guys I am trying to convert the code below to a function, I am trying to sort the data below the code by the first set of numbers it comes to. I think this would be the formula I would want to enter, or close to it "=vsortm(a1, a:a)"
This code works fine the way it is, but I need to use it as a function for the rest of the sheet to work.
Also I would like for it to ignore blank cells if at all possible
@jindon was the original writer of this code, I dont want to take credit for other people's hard work :/
2521 Bm P/L
2534 Oneok P/L
3091 ℄ Drain
3716 ℄ Drain
3895 Fence (BW)
3909 Southernstar P/L
3923 DCP P/L
3968 Edge Lse. Rd.
3979 Edge Lse. Rd.
4910 Top Bank
4962 ℄ Drain
4987 Top Bank
6127 Fence (BW)
6228 Fence (BW)
7081 ℄ Drain
8736 Transmission Line
8780 Fence (BW)
9840 Edge Lse. Rd.
9852 Edge Lse. Rd.
12214 P.I. ∠ 11°28' Lt.
12325 P.I. ∠ 24°26' Lt.
12484 Eol P/L
000 Bol P/L
008 Fence (BW)
1013 Edge Driveway
1026 Edge Driveway (5)
2458 Fence (BW)
2461 Aerial Power Line
2470 ℄ Ditch
2473 Edge Rd.
2483 ℄ Rd.
2491 Edge Rd.
2502 Fence (BW)
This code works fine the way it is, but I need to use it as a function for the rest of the sheet to work.
Also I would like for it to ignore blank cells if at all possible
@jindon was the original writer of this code, I dont want to take credit for other people's hard work :/
Code:
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Option Explicit
Sub test()
Dim a, i As Long
With Cells(1).CurrentRegion
a = .Value
ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2) + 1)
With CreateObject("VBScript.RegExp")
.Pattern = "\d+(\.\d+)?"
For i = 2 To UBound(a, 1)
If .test(a(i, 1)) Then a(i, UBound(a, 2)) = _
Format$(.Execute(a(i, 1))(0), String(20, "0")) & a(i, 1)
Next
End With
VSortM a, 2, UBound(a, 1), UBound(a, 2), 1
.Value = a
End With
End Sub
Private Sub VSortM(ary, LB, UB, ref, Optional ord As Boolean = 1)
Dim M As Variant, i As Long, ii As Long, iii As Long, temp
i = UB: ii = LB
M = ary(Int((LB + UB) / 2), ref)
Do While ii <= i
If ord Then
Do While ary(ii, ref) < M: ii = ii + 1: Loop
Else
Do While ary(ii, ref) > M: ii = ii + 1: Loop
End If
If ord Then
Do While ary(i, ref) > M: i = i - 1: Loop
Else
Do While ary(i, ref) < M: i = i - 1: Loop
End If
If ii <= i Then
For iii = LBound(ary, 2) To UBound(ary, 2)
temp = ary(ii, iii): ary(ii, iii) = ary(i, iii): ary(i, iii) = temp
Next
ii = ii + 1: i = i - 1
End If
Loop
If LB < i Then VSortM ary, LB, i, ref, ord
If ii < UB Then VSortM ary, ii, UB, ref, ord
End Sub</code>
2521 Bm P/L
2534 Oneok P/L
3091 ℄ Drain
3716 ℄ Drain
3895 Fence (BW)
3909 Southernstar P/L
3923 DCP P/L
3968 Edge Lse. Rd.
3979 Edge Lse. Rd.
4910 Top Bank
4962 ℄ Drain
4987 Top Bank
6127 Fence (BW)
6228 Fence (BW)
7081 ℄ Drain
8736 Transmission Line
8780 Fence (BW)
9840 Edge Lse. Rd.
9852 Edge Lse. Rd.
12214 P.I. ∠ 11°28' Lt.
12325 P.I. ∠ 24°26' Lt.
12484 Eol P/L
000 Bol P/L
008 Fence (BW)
1013 Edge Driveway
1026 Edge Driveway (5)
2458 Fence (BW)
2461 Aerial Power Line
2470 ℄ Ditch
2473 Edge Rd.
2483 ℄ Rd.
2491 Edge Rd.
2502 Fence (BW)