excel, seperating numbers and text, macro

G

Gene Shackman

I have a file with lines like these

nominally Roman Catholic 92% (less than 20% practicing)
Armenian Apostolic 94.7%
Roman Catholic 80.8%
Eastern Orthodox 80%
Roman Catholic 75%
Buddhist 9.3%
Baptist 42%

my file has 250 lines. I want to separate the data from the text. Is there
any way to do this other than manually going through each line and separating
the data? I considered a macro but each line is different. In some cases
the number has 2 digits and no decimals but in other cases it has decimals.

thanks
 
O

OssieMac

Hi Gene,

The following code will separate the first percentage value into a separate
column and remove it from the first column. I have not handled the "(less
than 20% practicing)" because not sure what you want to do with it. Maybe it
is OK left in the original data but let me know.

Note the comments where you might have to edit the code to suit.

Ensure you back up your data before running the code in case it does not do
exactly what you expect.

Sub SeparatePercentages()
Dim rngToSeparate As Range
Dim cel As Range
Dim i As Long
Dim strChar As String
Dim strTemp As String

'Edit sheet name to suit your sheet name
With Sheets("Sheet1")
'Edit the following range to suit range of your data
Set rngToSeparate = .Range("A1:A7")
End With

'Edit following line to suit required column for results
'It must be the next column to the right of the original data
Columns("B:B").NumberFormat = "0.00%"


For Each cel In rngToSeparate
strTemp = ""
For i = 1 To Len(cel.Value)
strChar = Mid(cel.Value, i, 1)

Select Case strChar
Case 0 To 9, ".", "%"
strTemp = strTemp & strChar
If strChar = "%" Then Exit For
End Select
Next i

'Extract value only from variable without % sign
cel.Offset(0, 1) = Val(Left(strTemp, Len(strTemp) - 1)) / 100

'Delete the value and percentage sign from original data
cel.Value = Replace(cel.Value, " " & strTemp, "")
Next cel

End Sub
 
J

JBeaucaire

This simple FUNCTION will strip the letters out of a cell leaving everything
else.
=========
Function LetterOut(rng As Range)
Dim i As Integer
For i = 1 To Len(rng)
Select Case Asc(Mid(rng.Value, i, 1))
Case 0 To 64, 123 To 197

LetterOut = LetterOut & Mid(rng.Value, i, 1)
End Select
Next i
End Function
==========
Paste that into a MODULE. Use it as:
=LetterOut(A1)

....or to remove the spaces left in there:
=TRIM(letterout(A1))

Here's another function to strip out numerals:
==========
Function StripNumber(stdText As String)
Dim str As String, i As Integer
'strips the number from a longer text string
stdText = Trim(stdText)

For i = 1 To Len(stdText)
If Not IsNumeric(Mid(stdText, i, 1)) Then
str = str & Mid(stdText, i, 1)
End If
Next i

StripNumber = str ' * 1
End Function
============

Use it as:
=StripNumber(A1)

Now, in your text there are periods and percent symbols left over, so I
added some color to strip that out in this final formula:
=TRIM(SUBSTITUTE(SUBSTITUTE(stripnumber(A1),".",""),"%",""))
 
R

Ron Rosenfeld

On Sun, 11 Jan 2009 21:13:00 -0800, Gene Shackman <Gene
I have a file with lines like these

nominally Roman Catholic 92% (less than 20% practicing)
Armenian Apostolic 94.7%
Roman Catholic 80.8%
Eastern Orthodox 80%
Roman Catholic 75%
Buddhist 9.3%
Baptist 42%

my file has 250 lines. I want to separate the data from the text. Is there
any way to do this other than manually going through each line and separating
the data? I considered a macro but each line is different. In some cases
the number has 2 digits and no decimals but in other cases it has decimals.

thanks
Click to expand...

Not sure exactly what you mean.

The following macro will
operate on a range of selected cells
clear a few cells adjacent to the selected cells
place the numeric values into the adjacent cells (including % signs)

The values are extracted as text strings.

==================================
Option Explicit
Sub GetData()
Dim c As Range
Dim i As Long
Dim re As Object, mc As Object, m As Object
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "[\-+]?\b\d*\.?\d+\b%?"

For Each c In Selection
Range(c(1, 2), c(1, 3)).ClearContents 'clear right of data
If re.test(c.Value) = True Then
Set mc = re.Execute(c.Value)
For i = 0 To mc.Count - 1
c(1, i + 2).Value = mc(i)

Next i
End If
Next c
End Sub
======================================

If you want to extract these as numbers, and divide by 100 if the % sign is
present, then use this:

===========================
Option Explicit
Sub GetData()
Dim c As Range
Dim i As Long
Dim re As Object, mc As Object, m As Object
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "[\-+]?\b\d*\.?\d+\b%?"

For Each c In Selection
Range(c(1, 2), c(1, 3)).ClearContents 'clear right of data
If re.test(c.Value) = True Then
Set mc = re.Execute(c.Value)
For i = 0 To mc.Count - 1
If Right(mc(i), 1) = "%" Then
c(1, i + 2).Value = Left(mc(i), Len(mc(i)) - 1) / 100
Else
c(1, i + 2).Value = CDbl(mc(i))
End If
Next i
End If
Next c
End Sub
==================================

--ron
 
Top