Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 21
Default Macro please!

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....

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,510
Default Macro please!

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


  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,501
Default Macro please!

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.


"LeisaA" wrote:



"Mike H" wrote:

Hi,

Taking you literally and noting you have a max of 2 all capitalised words
then this should do it

Sub Marine()
Dim TempStr As String
Set sHt = Sheets("Sheet1") ' Change to suit
lastrow = sHt.Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = sHt.Range("A1:A" & lastrow)
For Each c In MyRange
v = Split(c.Value, " ")
If v(0) = UCase(v(0)) Then TempStr = TempStr + v(0) & " "
If v(1) = UCase(v(1)) Then TempStr = TempStr + v(1)
c.Offset(, 1).Value = Trim(WorksheetFunction.Substitute(c.Value, TempStr, ""))
c.Value = Trim(TempStr)
TempStr = ""
Next
End Sub
--
Mike

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


"LeisaA" wrote:

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 Mike, I have more than two words some have 5 and some are more.???

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,510
Default Macro please!

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.


--
Regards,

OssieMac


  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 21
Default Macro please!

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


"OssieMac" wrote:

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




  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 54
Default Macro please!

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.

--
Ken
"Using Dbase dialects since 82"
"Started with Visicalc in the same year"


"OssieMac" wrote:

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.


--
Regards,

OssieMac


  #7   Report Post  
Posted to microsoft.public.excel.programming
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


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro to copy and paste values (columns)I have a macro file built C02C04 Excel Programming 2 May 2nd 08 01:51 PM
AutoRun Macro with a delay to give user the choice to cancel the macro wanderlust Excel Programming 2 September 28th 07 04:09 PM
Need syntax for RUNning a Word macro with an argument, called from an Excel macro Steve[_84_] Excel Programming 3 July 6th 06 07:42 PM
how to count/sum by function/macro to get the number of record to do copy/paste in macro tango Excel Programming 1 October 15th 04 01:16 PM
Start Macro / Stop Macro / Restart Macro Pete[_13_] Excel Programming 2 November 21st 03 05:04 PM


All times are GMT +1. The time now is 05:59 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"