I have a big list with full addresses in excel. Each address has a single cell. I am having trouble creating a formula to grab the street name to put in another cell and grabbing the city to put in a different cell.
Here is example cases of what my data looks like
12 Apple RD Harwich, MA 11111
1213 Strawberry Crossing Loop Tampa, FL 22222
123 Pear Dr. Colorado Springs, CO 33333
12345 RIVERSIDE DR Lowertown, PA 44444
6232 N Rockstar ST Philadelphia, PA 44444
123 TOWN ST Plympton, MA 55555
I didn't find a quick and easy way to solve your problem but here is a way to do the required work efficiently and fast - probably more so than if you spend time on getting code that will, at best, only produce a result that needs to be reviewed.
In a nutshell, the code offered here will create a textbox for each cell as you click on it. It's a textbox because it offers capabilities a cell doesn't have. In the text box you enter a single comma, to separate street address from city, and press enter. The split is done on the spot, is immediately editable, and the textbox moves to the next line.
The code can handle more commas. And it can handle each part individually. I have demonstrated this on the state and ZIP code part. There is a note in the code where you can remove this extra. The code also adds the comma (and any other changes made at that time) to the original data. There is another note in the code where you can remove a line to keep the original data untouched.
The code is a little elaborate and, at the same time, rough around the edges because it was adapted from another project. As it is now in consists of 2 parts. The first part contains event procedures which call other procedures in the other part. The latter also contains supporting functions for itself. The first part must be installed in the code module of the worksheet on which you want the action. That is the worksheet with the original addresses in them. You can install this same code behind several worksheets in the same workbook. Here is part 1.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' 069
Const StopAction As Boolean = False ' change to TRUE to stop
Const SourceClm As Long = 1 ' column containing the data
If StopAction Or Target.Column <> SourceClm Then
KillTbx Target
Else
SetTbx Target.Cells(1)
End If
End Sub
Private Sub Splitter_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
' NIC 047 09 Jun 2020
KeyCode = KeyUpEvent(KeyCode, Shift)
End Sub
Please observe the two constants at the top. You can set them to suit your needs. StopAction, if TRUE will disable the creation of text boxes, in fact returning your worksheet to its original behaviour. SourceClm specifies the column in which you have your original data. In my trials that was column A, identified by its number, 1. If you have several installations in the same workbook these settings can be individually different.
The code below goes into a standard code module. That is a module you have to insert. By default VBA will name it Module1. I recommend to rename it suitably. I named mine STO_62962096 which will help me find this thread again if ever needed.
Option Explicit
Private Const MagName As String = "Splitter"
Sub SetTbx(Target As Range)
' 069
Dim Tbx As OLEObject ' the TextBox being created
Dim BackColor As Long ' background color
Dim FontColor As Long ' font color
BackColor = 16777152 ' = sky blue
FontColor = vbBlack ' = 0
On Error Resume Next
Set Tbx = ActiveSheet.OLEObjects(MagName)
If Err Then
Set Tbx = Target.Worksheet.OLEObjects _
.Add(ClassType:="Forms.TextBox.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=100, Top:=100, _
Width:=100, Height:=20)
End If
With Tbx
With .Object
.BackColor = BackColor
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleSingle
.IntegralHeight = False
.ForeColor = FontColor
.Font.Size = Target.Font.Size
.Text = Target.Value
End With
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width
.Height = (Target.Offset(1).Top - .Top)
.Name = MagName
.Activate
End With
End Sub
Sub KillTbx(Target As Range)
' 069
Dim Tbx As OLEObject ' TextBox
On Error Resume Next
Set Tbx = Target.Worksheet.OLEObjects(MagName)
If Err = 0 Then Tbx.Delete
Err.Clear
Target.Select
End Sub
Function KeyUpEvent(ByVal KeyCode As Integer, _
ByVal Shift As Integer) As Integer
' 069
Dim Tbx As OLEObject
Dim n As Long ' offset
Set Tbx = ActiveSheet.OLEObjects(MagName)
If KeyCode = 13 Then ' Enter
With Tbx
SplitAddress .Object.Text, .TopLeftCell.Row
' remove the next line to KEEP original data
.TopLeftCell.Value = .Object.Text
KeyCode = 40 ' move to next row
End With
End If
Select Case KeyCode
Case 38, 40 ' Up-arrow / Down-arrow
n = IIf(KeyCode = 38, -1, 1)
Tbx.TopLeftCell.Offset(n).Select
Tbx.Object.Text = ActiveCell.Value
Case 9 ' tab: move right/left
n = IIf(Shift, -1, 1)
Tbx.TopLeftCell.Offset(, n).Select
Tbx.Object.Text = ActiveCell.Value
End Select
KeyUpEvent = KeyCode
End Function
Private Sub SplitAddress(ByVal Txt As String, _
ByVal Rt As Long)
' 069
Const TgtClm As Long = 4 ' first target column (change to suit)
Const StateClm As Long = 7 ' State followed by ZIP (change to suit)
Dim Sp() As String ' address array
Dim Ct As Long ' target column
Dim Arr As Variant ' output array
If Len(Txt) Then
ReDim Arr(1 To StateClm - TgtClm + 2)
Sp = Split(Txt, ",")
For Ct = 0 To UBound(Sp)
Arr(Ct + 1) = Trim(Sp(Ct))
Next Ct
' remove the next block of 5 lines to NOT separate state & ZIP
Sp = Split(Trim(Replace(Sp(Ct - 1), " ", " ")))
Arr(Ct) = ""
For Ct = 0 To UBound(Sp)
Arr(Ct + StateClm - TgtClm + 1) = Trim(Sp(Ct))
Next Ct
Cells(Rt, TgtClm).Resize(, UBound(Arr)).Value = Arr
Columns(TgtClm).Resize(, StateClm - TgtClm + 2).AutoFit
End If
End Sub
Look for the procedure SplitAddress and adjust the two constants you find there. The code splits the address into a, theoretically, unlimited number of parts. The first of these will be written to the column named TgtClm, 4 in the above code, which identifies column D. The State/ZIP combination has its own similar design and therefore its own first column (the first of 2 in this case). If you don't use this feature (you can disable it in this same procedure) set the constant StateClm to a number at least equal to the maximum number of splits you expect.
Note that the code creates an array with StateClm - TgtClm + 2 elements. If you only want 3 columns, as per your question, StateClm - TgtClm + 2 must be => 3. To the right of the result the code will over-write existing data for as many columns as this formula specifies.
