Extracting information from a list

  • Thread starter Thread starter Rob
  • Start date Start date
R

Rob

Excel 2000

I have a text list in column B that I need to loop through and if a certain
criteria is met, action taken. My issue is that the criteria is complex (or
at least I think it is).

The list in column B can be any number of rows from 2 to 20,000. An example
of the kind of data is shown below, some rows begin with a number and to
confuse things, they also start with a space before the number. What I need
to do is replace the entry with only the text from each row eg. 75 Total
Sales becomes Total Sales whereas Sales at retail Price remains the same.

BEFORE EXAMPLE
75 Total Sales
113 Wholesale Rounds
114 Cat food
115 Cat litter
16 Other item
Sales at Retail Price
Net sales at Wholesale


AFTER EXAMPLE
Total Sales
Wholesale Rounds
Cat food
Cat litter
Other item
Sales at Retail Price


The formula below achieves what's required except I'm importing the
information and need to automate the cleaning process of data at the point
of import.

=TRIM(IF(ISNUMBER(VALUE(MID(B5,2,SEARCH(" "&"*"&"
",B5,2)-2))),RIGHT(B5,LEN(B5)-SEARCH(" "&"*"&" ",B5,2)),B5))

Any pointers most welcome. Rob
 
Hi Rob

Here's one solution. Select the range and run. If you select B it writes the
number in C and the text in D, so make sure you have two columns free to the
right.

Option Explicit '**** top of standard module

Type RowInfo
Nr As Long
Txt As String
End Type

Sub CleanList()
Dim A As Range, Cel As Range
Dim CelItem As RowInfo
Set A = Intersect(Selection, ActiveSheet.UsedRange)
For Each Cel In A
CelItem = This(Cel.Value)
If CelItem.Nr <> 0 Then Cel.Offset(0, 1).Value = CelItem.Nr
Cel.Offset(0, 2).Value = CelItem.Txt
Next
End Sub

Function This(S As String) As RowInfo
Dim L As Long
Dim C As String, Ctmp As String

For L = 1 To Len(S)
C = Mid$(S, L, 1)
Select Case Asc(C)
Case 49 To 57
Ctmp = Ctmp & C
Case 64 To 128
Exit For
Case Else
End Select
Next
This.Nr = Val(Ctmp)
This.Txt = Trim$(Mid$(S, L))
End Function
 
Harald,

Thanks for this, I'll try it out. Would you then suggest copying the
contents of column D to Column B?

Regards, Rob
 
Harald,

Have run the code and it works well, however, where the number ends in a
zero i.e. 10, 20 100 etc. the zeros are left off. I know this wasn't an
original query but it would be useful to have column C show the number in
full. Tried to unravel the code you provided but failed!

Thanks, Rob
 
Hi Rob

Extremely embarassing. I write code just like that several times a day.
Change
Case 49 To 57
to
Case 48 To 57

Ascii 48 is zero. I should remember that by now...
 
Rob,

Replace Harald's function with this

Function This(S As String) As RowInfo
Dim L As Long
Dim C As String, Ctmp As String

For L = 1 To Len(S)
C = Mid$(S, L, 1)
Select Case Asc(C)
Case 48 To 57
Ctmp = Ctmp & C
Case 64 To 128
Exit For
Case Else
End Select
Next
This.Nr = Val(Ctmp)
This.Txt = Trim$(Mid$(S, L))
End Function

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Bob & Harald,

Thanks to you both. Rob

Bob Phillips said:
Rob,

Replace Harald's function with this

Function This(S As String) As RowInfo
Dim L As Long
Dim C As String, Ctmp As String

For L = 1 To Len(S)
C = Mid$(S, L, 1)
Select Case Asc(C)
Case 48 To 57
Ctmp = Ctmp & C
Case 64 To 128
Exit For
Case Else
End Select
Next
This.Nr = Val(Ctmp)
This.Txt = Trim$(Mid$(S, L))
End Function

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

free
Click to expand...
 
With 20,000 lines, would this work?
The list in column B can be any number of rows from 2 to 20,000.
Click to expand...

Sub Demo()
Dim n As Long
Dim Cell As Range

With Columns("B:B")

For n = 0 To 9
.Replace n, vbNullString
Next n

.Cells.Select
For Each Cell In .Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
Cell = Trim(Cell)
Next Cell

End With
End Sub
 
Back
Top