Cleaning up data -- any way to globally fix this??

T

The Moose

<B>Flamingo Cookie Jar</B><BR>Made of porcelain and measures Body 6" x
7" With Lid and tail 10"x11"

gets converted to this in either a CSV worksheet or an XLS worksheet:

Flamingo Cookie JarMade of porcelain and measures Body 6" x 7" With
Lid and tail 10"x11"

The <BR> gets eliminated between the heading and the description which
causes two words to be 'stuck' together.

Spell checking finds them -- but, there are thousands of these -- is
there any way to fix this automatically?? (I don't have access to the
source data.)

Thanks.

Barb
 
K

Ken Johnson

The said:
<B>Flamingo Cookie Jar</B><BR>Made of porcelain and measures Body 6" x
7" With Lid and tail 10"x11"

gets converted to this in either a CSV worksheet or an XLS worksheet:

Flamingo Cookie JarMade of porcelain and measures Body 6" x 7" With
Lid and tail 10"x11"

The <BR> gets eliminated between the heading and the description which
causes two words to be 'stuck' together.

Spell checking finds them -- but, there are thousands of these -- is
there any way to fix this automatically?? (I don't have access to the
source data.)

Thanks.

Barb
Click to expand...

Hi Barb,

this macro checks each cell of the selected range for instances of a
lowercase character followed by an uppercase character without an
intervening space. When such an instance is found a space is
inserted...

Public Sub AddSpc()
Application.ScreenUpdating = False
Dim rngAddSpace As Range
Dim rngCell As Range
Set rngAddSpace = Application.InputBox( _
prompt:="Select Cells with missing space", _
Title:="Add Missing Space", _
Default:=Selection.Address, _
Type:=8)
Dim strArray() As String
Dim I As Long
Dim Character As Long
For Each rngCell In rngAddSpace
strArray = Split(rngCell, " ")
For I = 0 To UBound(strArray)
For Character = 1 To Len(strArray(I)) - 1
If UCase(Mid(strArray(I), Character, 1)) _
<> Mid(strArray(I), Character, 1) _
And UCase(Mid(strArray(I), Character + 1, 1)) _
= Mid(strArray(I), Character + 1, 1) Then
strArray(I) = Left(strArray(I), Character) _
& Space(1) _
& Mid(strArray(I), Character + 1, 255)
End If
Next Character
Next I
rngCell.Value = Join(strArray)
Next rngCell
End Sub


Try it out on a copy of your data first just in case it doesn't do what
you want.

Ken Johnson
 
K

Ken Johnson

Ken said:
Hi Barb,

this macro checks each cell of the selected range for instances of a
lowercase character followed by an uppercase character without an
intervening space. When such an instance is found a space is
inserted...

Public Sub AddSpc()
Application.ScreenUpdating = False
Dim rngAddSpace As Range
Dim rngCell As Range
Set rngAddSpace = Application.InputBox( _
prompt:="Select Cells with missing space", _
Title:="Add Missing Space", _
Default:=Selection.Address, _
Type:=8)
Dim strArray() As String
Dim I As Long
Dim Character As Long
For Each rngCell In rngAddSpace
strArray = Split(rngCell, " ")
For I = 0 To UBound(strArray)
For Character = 1 To Len(strArray(I)) - 1
If UCase(Mid(strArray(I), Character, 1)) _
<> Mid(strArray(I), Character, 1) _
And UCase(Mid(strArray(I), Character + 1, 1)) _
= Mid(strArray(I), Character + 1, 1) Then
strArray(I) = Left(strArray(I), Character) _
& Space(1) _
& Mid(strArray(I), Character + 1, 255)
End If
Next Character
Next I
rngCell.Value = Join(strArray)
Next rngCell
End Sub


Try it out on a copy of your data first just in case it doesn't do what
you want.

Ken Johnson
Click to expand...

Hi Barb,

Sorry!

I added the ScreenUpdating = False to speed things up, forgetting that
it interferes with the inputbox, making it impossible to select the
range of cells to work on. Use the following instead ...

Public Sub AddSpc()
Dim rngAddSpace As Range
Dim rngCell As Range
Set rngAddSpace = Application.InputBox( _
prompt:="Select Cells with missing space", _
Title:="Add Missing Space", _
Default:=Selection, _
Type:=8)
Dim strArray() As String
Dim I As Long
Dim Character As Long
Application.ScreenUpdating = False
For Each rngCell In rngAddSpace
strArray = Split(rngCell, " ")
For I = 0 To UBound(strArray)
For Character = 1 To Len(strArray(I)) - 1
If UCase(Mid(strArray(I), Character, 1)) _
<> Mid(strArray(I), Character, 1) _
And UCase(Mid(strArray(I), Character + 1, 1)) _
= Mid(strArray(I), Character + 1, 1) Then
strArray(I) = Left(strArray(I), Character) _
& Space(1) _
& Mid(strArray(I), Character + 1, 255)
End If
Next Character
Next I
rngCell.Value = Join(strArray)
Next rngCell
End Sub

Also, if there is a missing space between an inch symbol and a capital
as in (6" x 7"With) it won't add the missing space. This doesn't appear
to be an applicable problem, however, just in case it is, the following
code could be used. It searches for capitals without a preceding space,
then inserts one...

Public Sub AddSpc2()
Dim rngAddSpace As Range
Dim rngCell As Range
Set rngAddSpace = Application.InputBox( _
prompt:="Select Cells with missing space", _
Title:="Add Missing Space", _
Default:=Selection.Address, _
Type:=8)
Dim strArray() As String
Dim I As Long
Dim Character As Long
Application.ScreenUpdating = False
For Each rngCell In rngAddSpace
strArray = Split(rngCell, " ")
For I = 0 To UBound(strArray)
For Character = 2 To Len(strArray(I)) - 1
If UCase(Mid(strArray(I), Character, 1)) _
<> Space(1) _
And (Asc(Mid(strArray(I), Character + 1, 1)) > 64 _
And Asc(Mid(strArray(I), Character + 1, 1)) < 91) Then
strArray(I) = Left(strArray(I), Character) _
& Space(1) _
& Mid(strArray(I), Character + 1, 255)
End If
Next Character
Next I
rngCell.Value = Join(strArray)
Next rngCell
End Sub


Ken Johnson
 
T

The Moose

Ken,

Thanks so much. I owe you my first-born grandchild :GRIN: You just
added about 10 years to my life.

The first macro actually worked beautifully (probably because I had
already selected the text to be worked on). Actually, it failed the
first time -- I didn't realize there was an empty description cell --
so you proofread at the same time.!! After I fixed the missing data,
the macro worked beautifully.

I DO have instances of double-quotes for inches (you read my mind) --
so the third is PURR-FECT!! I just tested it -- SWEET!!

Thank you-thank you. You have no idea how much help you've been.

Barb
 
Top