Excel number and box issues - excel

Question

I have an excel file full of adresses which I need to import in our system.
the housenumber column is formatted like this:
Normal house numbers just show the number but house numbers with a certain boxnumber are shown like this: 25 B12
I need to get the boxnumbers (if they exist) in another column
I managed to do this with these functions
Function GetBus(Text As String, ByRef NumberCell As Range) As String
Dim LastWord As String
LastWord = ReturnLastWord(Text)
If Left(LastWord, 1) = "B" Then
GetBus = Right(LastWord, Len(LastWord) - 1)
Else
GetBus = ""
End If
End Function
Function ReturnLastWord(Text As String) As String
Dim LastWord As String
LastWord = StrReverse(Text)
LastWord = Left(LastWord, InStr(1, LastWord, " ", vbTextCompare))
ReturnLastWord = StrReverse(Trim(LastWord))
End Function
So creating the new column with the box values is working. What is not working is deleting the box part in the number column (fe: if number value is 25 B1 the B1 part should be removed)
Any Ideas of how to do this or is this not possible in excel?

Answer 1

This is something which I wrote couple of years ago so I am not sure if there are bugs in it but a quick test seems to portray that it is working correctly. You might have to change it to make it exactly work in your situation.
Code:
Option Explicit
Sub SplitAddress()
Dim MyAr() As String, tempStr As String, strUnique As String
Dim lRow As Long, i As Long, j As Long, lRow2 As Long
Dim cell As Range
strUnique = "SiddR" & Format(Now, "ddmmyyhhmmss")
With ActiveSheet
.Columns("A:A").Replace What:=" ", Replacement:=strUnique, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Columns("C").NumberFormat = "#"
.Columns("D").NumberFormat = "#"
For i = 2 To lRow
MyAr = Split(.Range("A" & i).Value, strUnique)
tempStr = ""
For j = LBound(MyAr) To (UBound(MyAr) - 1)
If tempStr = "" Then
tempStr = MyAr(j)
Else
tempStr = tempStr & " " & MyAr(j)
End If
Next j
.Range("B" & i).Value = tempStr
.Range("C" & i).Value = MyAr(UBound(MyAr))
Next i
For i = 2 To lRow
If Not IsNumeric(.Range("C" & i).Value) Then
tempStr = ""
For j = 1 To Len(.Range("C" & i).Value)
If IsNumeric(Mid(.Range("C" & i).Value, j, 1)) Then
If tempStr = "" Then
tempStr = Mid(.Range("C" & i).Value, j, 1)
Else
tempStr = tempStr & Mid(.Range("C" & i).Value, j, 1)
End If
Else
Exit For
End If
Next
.Range("D" & i).Value = Mid(.Range("C" & i).Value, j)
.Range("C" & i).Value = tempStr
If Len(Trim(tempStr)) = 0 Then
MyAr = Split(.Range("A" & i).Value, strUnique)
.Range("C" & i).Value = MyAr(UBound(MyAr) - 1)
End If
End If
Next
.Columns("A:A").Replace What:=strUnique, Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Columns("D:D").Replace What:="-", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
End Sub
Screenshot:
Screenshot:
With your test data
EDIT: Now when I look at this code again, I see that it can be optimized much much further :)