amb2301
05-18-2020, 01:54 AM
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-programming-vba-macros/1316009-vba-required-to-delimit-cells-with-some-rules-applied-on-it.html
https://www.excelguru.ca/forums/showthread.php?10645-VBA-required-to-delimit-cells-with-Rules-applied-over-it&
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-programming-vba-macros/1316009-vba-required-to-delimit-cells-with-some-rules-applied-on-it.html
https://www.excelguru.ca/forums/showthread.php?10645-VBA-required-to-delimit-cells-with-Rules-applied-over-it&