VBA required to delimit cells with Rules applied over it.

[amb2301]

Hi Friends,

Firstly Thanks to DocAElstein for reffering me to this Forum.


i need a help on fixing an existing VBA script,

Function of Existing Script:
i have hundreds of addresses to Delimit into seperate cells as shown in the attached sample file(Address sheet.xlsm)
i have a script to delimit those addresses Available in A column to the B,C,D & E column.
COlumn A: contains full address
COlumn B: Door number
COlumn C: Direction (N,E,S,W)
COlumn D: Street Name
COlumn E: Street Type

Twist is at Directions(N,E,S,W), sometimes it comes next to Door# (or) at the end of an address.
existing script, even do that work perfectly.

Current Requirement:
Now some addresses comes with different scenarios,
i have highlighted in yellow colour in the attached excel(green higlighted cells are working fine with existing script).
if single Numberical value (1,2,3.4,5,6,7,8,9) comes in C column,it should be moved to the D column
by adding text like(1st,2nd,3rd,4th,5th,6th,7th,8th,9th).

Could anyone please help me to resolve this issue.

Sub Demo1()
    Dim V(), W(), R&, S, C%
        V = Application.Trim(Range("A2", [A1].End(xlDown)))
        ReDim W(1 To UBound(V), 3)
    For R = 1 To UBound(V)
           S = Split(V(R, 1))
        If IsNumeric(S(0)) Then
                W(R, 0) = S(0)
            If Len(S(1)) = 1 Then
                W(R, 1) = S(1):  W(R, 2) = S(2):  W(R, 3) = S(3)
            ElseIf Len(S(UBound(S))) = 1 Then
                W(R, 1) = S(UBound(S)):  W(R, 2) = S(1):  W(R, 3) = S(2)
            Else
                If UBound(S) = 3 Then W(R, 2) = S(1) & " " & S(2) Else W(R, 2) = S(1)
                W(R, 3) = S(UBound(S))
            End If
        Else
           W(R, 0) = Left(S(0), Len(S(0)) - 1):  W(R, 1) = Right(S(0), 1):  W(R, 2) = S(1): W(R, 3) = S(2)
        End If
    Next
        [B2:E2].Resize(R - 1) = W
End Sub

Thanks in Advance.

---

Cross Posts:
https://www.excelforum.com/excel-pro...ied-on-it.html
https://www.excelguru.ca/forums/show...plied-over-it&