Hi Leisa,

The following will place the output data into a separate sheet. This way, if
it does not do exactly what you want then it does not destroy the Input data.

You may need to edit the sheet names. See comments. Ensure that the sheet
name you use for wsOutput is a blank sheet.

The code recognizes the first lowercase character and processes back from
there to get the final left string. Therefore it does not matter how many
words there are in the first (left section) so long as they are all uppercase.

Sub ParseData()
Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim rngData As Range
Dim c As Range
Dim strInit As String
Dim strLeft As String
Dim strRight As String
Dim i As Long

'Edit "Sheet1" to you data input sheet
Set wsInput = Sheets("Sheet1")

'Edit "Sheet2" to you data output sheet
Set wsOutput = Sheets("Sheet2")

With wsInput
Set rngData = .Range(.Cells(2, "A"), _
.Cells(.Rows.Count, "A").End(xlUp))
End With

With wsOutput
.Range("A1") = "Left String"
.Range("B1") = "Right String"
.Range("A1:B1").Font.Bold = True
End With

For Each c In rngData
'Ensure no leading or trailing spaces
'in the initial string.
strInit = Trim(c.Value)
strLeft = ""
For i = 1 To Len(strInit)
If (Mid(strInit, i, 1) = "A" _
And Mid(strInit, i, 1) <= "Z") _
Or Mid(strInit, i, 1) = Chr(32) Then

strLeft = strLeft & Mid(strInit, i, 1)
Else
Exit For
End If
Next i
strLeft = Left(strLeft, Len(strLeft) - 1)
strRight = Mid(strInit, (Len(strLeft) + 1))
strLeft = Trim(strLeft) 'Remove last space
With wsOutput
.Cells(.Rows.Count, "A").End(xlUp) _
.Offset(1, 0) = strLeft

.Cells(.Rows.Count, "B").End(xlUp) _
.Offset(1, 0) = strRight
End With
Next c
wsOutput.Columns("A:B").Columns.AutoFit
End Sub

--
Regards,

OssieMac