Macro please!
Hi Leisa,
If you get back to this then I think that you have Input data that does not
meet the criteria. What do you want to do with these? The following code will
pop up a message re the address where there is a problem and then enter a
notation in the output and set its color to red for easy identification.
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 "Sheet14" to your data input sheet
Set wsInput = Sheets("Sheet14")
'Edit "Sheet15" to your data output sheet
Set wsOutput = Sheets("Sheet15")
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
If Len(strLeft) < 2 Then
MsgBox "Data at " & c.Address(0, 0) _
& " does not meet criteria"
With wsOutput
.Cells(.Rows.Count, "A").End(xlUp) _
.Offset(1, 0) = "Input data problem"
.Cells(.Rows.Count, "A").End(xlUp) _
.Font.ColorIndex = 3
.Cells(.Rows.Count, "B").End(xlUp) _
.Offset(1, 0) = "Input data problem"
.Cells(.Rows.Count, "B").End(xlUp) _
.Font.ColorIndex = 3
End With
Else
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
End If
Next c
wsOutput.Columns("A:B").Columns.AutoFit
End Sub
--
Regards,
OssieMac
|