Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro to copy and paste values (columns)I have a macro file built | Excel Programming | |||
AutoRun Macro with a delay to give user the choice to cancel the macro | Excel Programming | |||
Need syntax for RUNning a Word macro with an argument, called from an Excel macro | Excel Programming | |||
how to count/sum by function/macro to get the number of record to do copy/paste in macro | Excel Programming | |||
Start Macro / Stop Macro / Restart Macro | Excel Programming |