Macro please!

  • Thread starter Thread starter LeisaA
  • Start date Start date
L

LeisaA

I had some really great help yesterday, thanks to all that contributed!
However, I did not have success with the suggestions for this issue, I don't
know how to preform a nested function so macros work better for me can anyone
construct one for this? Thanks!

I'm trying to separate data as follows:

From this:
AAIM Aircraft Autonomous Integrity Monitor
ABAS Aircraft Based Augmenting System.

To this:
AAIM Aircraft Autonomous Integrity Monitor
ABAS Aircraft Based Augmenting System.

All caps to column 1 except the first letter of the sentence.

It won't work on space because I also have as follows:

ACCELERATION EAST Aircraft acceleration in true east direction
ACCELERATION EAST Aircraft acceleration in true east direction

To replace? I have 4958 lines....
 
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
 
yes I guessed that see my next post
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.
 
Hi again Leisa,

I should have said that the following code assumes that the input data is in
column A and starts at row 2 (that is you have a column header)

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

Also I now see you have other options.
 
Hello Ossie, I tried it with editing sheet 14 is where the data is at now and
sheet 15 should be the destination but I got an error on this line:

strLeft = Left(strLeft, Len(strLeft) - 1)

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 you data input sheet
Set wsInput = Sheets("Sheet14")

'Edit "Sheet15" to you 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
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
 
Leisa

The most likely cause for the
'strLeft = Left(strLeft, Len(strLeft) - 1) '
problem is that strLeft is zero length string which causes the 2nd parameter
to evaluate as a negative number.
 
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
 
Back
Top