Can someone help me create a macro that will search for a lowercase
letter immediately followed by an uppercase letter and then insert a
character in between? I can then do a text to columns to split them
up...I've got a bunch of text that got jammed together.

thanks very much!!

Hi,

Two macros slightly different. They only process one string. Can you handle
writing the code for a loop to repeat for all cells down the page?

The following does exactly as requested:-

Sub Search_String()

Dim strToSearch As String
Dim strFound1 As String
Dim strFound2
Dim lgthString As Long
Dim strNew As String
Dim i As Long

strToSearch = Range("A1")

lgthString = Len(strToSearch)

'Assign first character to new string
strNew = Left(strToSearch, 1)

'Start search from second character
For i = 2 To lgthString
strFound1 = Mid(strToSearch, i, 1)

'test for uppercase
If strFound1 = "A" And strFound1 <= "Z" Then

'If uppercase, test next character for lower case
strFound2 = Mid(strToSearch, i + 1, 1)
If strFound2 = "a" And strFound2 <= "z" Then
strNew = strNew & "," & strFound1
Else
strNew = strNew & strFound1
End If
Else
strNew = strNew & strFound1
End If
Next i

'Ensure that the following range is blank
'so as not to overwrite data
Range("B1") = strNew


End Sub

The following places a comma before every uppercase character:-

Sub Search_String_2()

Dim strToSearch As String
Dim strFound1 As String
Dim lgthString As Long
Dim strNew As String
Dim i As Long

strToSearch = Range("A1")

lgthString = Len(strToSearch)

strNew = Left(strToSearch, 1)
For i = 2 To lgthString
strFound1 = Mid(strToSearch, i, 1)
If strFound1 = "A" And strFound1 <= "Z" Then
strNew = strNew & "," & strFound1
Else
strNew = strNew & strFound1
End If
Next i

'Ensure that the following range is blank
'so as not to overwrite data
Range("C1") = strNew


End Sub

Regards,

OssieMac



" wrote:

Can someone help me create a macro that will search for a lowercase
letter immediately followed by an uppercase letter and then insert a
character in between? I can then do a text to columns to split them
up...I've got a bunch of text that got jammed together.

thanks very much!!

Hi again,

This was an interesting exercise and I decided to add to the code to include
the loop to process a column of data and add it to my library of routines.

Both macros assume that the data is in column A and that the column to the
right of the initial data is blank.

I have just re-read you request and I realize now that I tested for an
uppercase character followed by a lowercase. Your request was for a lowercase
character followed by uppercase. At the moment I can't think how it could
make a difference because the delimiter still goes in front of the uppercase
character. However, if it does make a difference, then provide me with an
example and I'll have another look at it. Generally I think that the second
option which only looks for the uppercase characters should work
satisfactorily.


Option 1:-
'This processes by finding uppercase followed by lowercase.
'Comma is inserted in front of the uppercase character
'Ensure that the column to the right of the data
'is blank so as not to overwrite any data.


Sub Search_String_Loop()

Dim strToSearch As String 'Initial string
Dim strFound1 As String 'Each character in string
Dim strFound2 'Character after uppercase character
Dim lgthString As Long 'Length of initial string
Dim strNew As String 'New string with delimiters
Dim i As Long 'Loop incrementing variable
Dim strDelimiter As String 'Delimiter to use
Dim rngSelect As Range 'Range to process
Dim c As Range 'Each cell in range to process


'Edit sheet name to match your sheet name
'Edit column Id ("A") to match your column
With Sheets("Sheet1")
Set rngSelect = Range(Cells(1, "A"), _
Cells(Rows.Count, "A").End(xlUp))
End With

'Edit to use delimiter other than comma
strDelimiter = ","

For Each c In rngSelect

strToSearch = c.Value

lgthString = Len(strToSearch)

'Assign first character to new string
strNew = Left(strToSearch, 1)

'Extract and test each character from second
'character and progressively from value of i
For i = 2 To lgthString
strFound1 = Mid(strToSearch, i, 1)

'Test character for uppercase
If strFound1 = "A" And strFound1 <= "Z" Then

'If uppercase, test next character for lower case
strFound2 = Mid(strToSearch, i + 1, 1)
If strFound2 = "a" And strFound2 <= "z" Then
'is uppercase followed by lower case so add
'delimiter plus uppercase character to new string
strNew = strNew & strDelimiter & strFound1
Else
'is uppercase but not followed by lowercase
'so only add uppercase character
strNew = strNew & strFound1
End If
Else
'not uppercase character so
'only add the lowercase character
strNew = strNew & strFound1
End If
Next i
'paste new string in cell to right.
c.Offset(0, 1) = strNew

Next c

End Sub



Option 2:-

'This places a comma before every uppercase character
'Ensure that the column to the right of the data
'is blank so as not to overwrite any data.

Sub Search_String_2()

Dim strToSearch As String 'Initial string
Dim strFound1 As String 'Each character in string
Dim lgthString As Long 'Length of initial string
Dim strNew As String 'New string with delimiters
Dim i As Long 'Loop incrementing variable
Dim strDelimiter As String 'Delimiter to use
Dim rngSelect As Range 'Range to process
Dim c As Range 'Each cell in range to process

'Edit sheet name to match your sheet name
'Edit column Id ("A") to match your column
With Sheets("Sheet1")
Set rngSelect = Range(Cells(1, "A"), _
Cells(Rows.Count, "A").End(xlUp))
End With

'Edit to use delimiter other than comma
strDelimiter = ","

For Each c In rngSelect
strToSearch = c.Value

lgthString = Len(strToSearch)

'Assign first character to new string
strNew = Left(strToSearch, 1)

'Extract and test each character from second
'character and progressively from value of i
For i = 2 To lgthString
strFound1 = Mid(strToSearch, i, 1)

'Test character for uppercase
If strFound1 = "A" And strFound1 <= "Z" Then
'is uppercase so add delimiter plus
'uppercase character to new string
strNew = strNew & strDelimiter & strFound1
Else
'not uppercase character so
'only add the lowercase character
strNew = strNew & strFound1
End If
Next i
'paste new string in cell to right.
c.Offset(0, 1) = strNew
Next c

End Sub

Regards,

OssieMac

On Fri, 02 Nov 2007 04:52:53 -0000, wrote:

Can someone help me create a macro that will search for a lowercase
letter immediately followed by an uppercase letter and then insert a
character in between? I can then do a text to columns to split them
up...I've got a bunch of text that got jammed together.

thanks very much!!

Easily done using Regular Expressions

Enter this in a regular module. (Back up your data first).

==================================
Option Explicit
Sub InsSpc()
Dim c As Range
Dim re As Object
Const sPat As String = "([a-z])([A-Z])"
Const sRes As String = "$1 $2"

Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat

'you can change Selection to a defined range
'or rewrite this as a function
'Be sure to backup data before running

For Each c In Selection
c.Value = re.Replace(c.Text, sRes)
Next c

End Sub
===========================
--ron

On Fri, 02 Nov 2007 18:09:17 -0400, Ron Rosenfeld
wrote:

On Fri, 02 Nov 2007 04:52:53 -0000, wrote:

Can someone help me create a macro that will search for a lowercase
letter immediately followed by an uppercase letter and then insert a
character in between? I can then do a text to columns to split them
up...I've got a bunch of text that got jammed together.

thanks very much!!

Easily done using Regular Expressions

Enter this in a regular module. (Back up your data first).

==================================
Option Explicit
Sub InsSpc()
Dim c As Range
Dim re As Object
Const sPat As String = "([a-z])([A-Z])"
Const sRes As String = "$1 $2"

Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat

'you can change Selection to a defined range
'or rewrite this as a function
'Be sure to backup data before running

For Each c In Selection
c.Value = re.Replace(c.Text, sRes)
Next c

End Sub
===========================
--ron

I forgot to mention that the above inserts a <space between the characters.

If you want to insert something else, change the Const sRes

In that constant:
$1 is the lower case letter
$2 is the upper case letter
Whatever is in between will be inserted.

So, for example, to insert a

dash
"$1-$2"

comma <space

"$1, $2"

etc.

Also, to enter the code into a regular module:

<alt-F11 opens the VB Editor
Ensure your project is highlighted in the project explorer window, then
insert/module and paste the code into the window that opens.

As written, the code acts on "Selection", But you could change to work on any
range.
--ron

This works perfectly!

You have to make sure you have a 'finite' selection instead of
clicking the column header to select the entire column or it will fun
forever.

Thanks very much!!

This works perfectly!

You have to make sure you have a 'finite' selection instead of
clicking the column header to select the entire column or it will fun
forever.

Thanks very much!!

On Sat, 03 Nov 2007 18:52:40 -0000, wrote:

This works perfectly!

You have to make sure you have a 'finite' selection instead of
clicking the column header to select the entire column or it will fun
forever.

Thanks very much!!


Thanks for the feedback. Glad to help.

I cannot reproduce your problem by selecting a column header.

It does take longer with blank rows than if all the rows are filled with a
single, short, garbage phrase. But even with all the cells empty, it still
only took about 10-12 seconds to run.

A small modification makes it do an entire blank column much quicker -- about
six seconds on my machine.

================================
Option Explicit
Sub InsSpc()
Dim c As Range
Dim sTemp As String
Dim re As Object
Const sPat As String = "([a-z])([A-Z])"
Const sRes As String = "$1 $2"

Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat

'you can change Selection to a defined range
'or rewrite this as a function
'Be sure to backup data before running

For Each c In Selection
sTemp = c.Text
If re.test(sTemp) = True Then _
c.Value = re.Replace(sTemp, sRes)
Next c

End Sub
=================================

An additional approach would be to change the selection to include only those
cells with data.


--ron

Hi Ron,

I am really impressed. I always like to learn better methods.

Regards,

OssieMac

"Ron Rosenfeld" wrote:

On Sat, 03 Nov 2007 18:52:40 -0000, wrote:

This works perfectly!

You have to make sure you have a 'finite' selection instead of
clicking the column header to select the entire column or it will fun
forever.

Thanks very much!!


Thanks for the feedback. Glad to help.

I cannot reproduce your problem by selecting a column header.

It does take longer with blank rows than if all the rows are filled with a
single, short, garbage phrase. But even with all the cells empty, it still
only took about 10-12 seconds to run.

A small modification makes it do an entire blank column much quicker -- about
six seconds on my machine.

================================
Option Explicit
Sub InsSpc()
Dim c As Range
Dim sTemp As String
Dim re As Object
Const sPat As String = "([a-z])([A-Z])"
Const sRes As String = "$1 $2"

Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat

'you can change Selection to a defined range
'or rewrite this as a function
'Be sure to backup data before running

For Each c In Selection
sTemp = c.Text
If re.test(sTemp) = True Then _
c.Value = re.Replace(sTemp, sRes)
Next c

End Sub
=================================

An additional approach would be to change the selection to include only those
cells with data.


--ron

On Sat, 3 Nov 2007 15:54:00 -0700, OssieMac
wrote:

Hi Ron,

I am really impressed. I always like to learn better methods.

Regards,

OssieMac

Regular Expressions are a pretty nifty way of doing more complicated text
manipulations. And, fortunately, they are supported to some extent by MS.
--ron