Thread: Macro please!
View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
OssieMac OssieMac is offline
external usenet poster
 
Posts: 2,510
Default 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