PDA

View Full Version : Copy Leading Numeric Values, then Remove



stuartgb100
01-06-2017, 02:43 AM
Hi,

I have imported the contents of a pdf into Excel.
In the pdf there were 2 columns, but in Excel there is only one.

I now have many rows similar to:

1.1 This is the start etc ''' This is in column B

and ending

25.15 This is the end

So the data is a combination of a leading numeric value followed by text
I need to split this up so as to achieve:

1.1 the numeric value in col A and This is the start (the text) left in col B

Not all the rows start with numbers.

Some rows could be as follows (say)

12.31 25x50 for example

In this case only the 12.31 should move to col A.

Can anyone get me started please ?

Thanks.

Bob Phillips
01-06-2017, 02:48 AM
Not all the rows start with numbers.

Some rows could be as follows (say)

12.31 25x50 for example

Isn't this a direct contradiction, the example starts with a number.

Bob Phillips
01-06-2017, 03:02 AM
But this might be what you want


Public Function SplitData()
Dim lastnum As Long
Dim lastrow As Long
Dim i As Long, ii As Long

Application.ScreenUpdating = False

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To lastrow

For ii = Len(.Cells(i, "A").Value) To 1 Step -1

If IsNumeric(Mid$(.Cells(i, "A").Value, ii, 1)) Then

Do

ii = ii - 1
Loop Until Mid$(.Cells(i, "A").Value, ii, 1) = " "

.Cells(i, "B").Value = Mid$(.Cells(i, "A").Value, ii + 1, Len(.Cells(i, "A").Value) - ii)
.Cells(i, "A").Value = Left$(.Cells(i, "A").Value, ii - 1)
ii = 1
End If
Next ii
Next i
End With

Application.ScreenUpdating = True
End Function

stuartgb100
01-06-2017, 03:07 AM
Normally the rows start with text, and can be ignored.

The rows I'm after start with a number.
The number is in a decimal format ie 15.2 or 15.23


Normally it would be 15.2 Then text follows, but sometimes
it can be 15.2 25x75 or 15.2 25 then text follows


So it's not just a case of removing all leading numbers before the text.
Just any leading numbers in decimal format.

Hope this clears up my muddled post
Apologies.

GTO
01-06-2017, 04:08 AM
Could you attach a smallish workbook showing before and desired after? This way we could easier see the way to a successful pattern...

stuartgb100
01-06-2017, 04:38 AM
Book 1 is attached (hopefully).

Many thanks.

GTO
01-06-2017, 08:07 AM
Here was my take, I used a small/simple pattern and used Regular Expressions. If you choose to try this way, there are many articles you can read. RegExp is not intuitive IMO, but it can do some neat stuff. Anyways, here's a link to an intro: https://msdn.microsoft.com/en-us/library/ms974570.aspx



Option Explicit

Sub example()
Const HEADER_ROW_COUNT = 3 '<---change to suit
Const COLUMN_NUMBER = 2 '<---SAA

' late-bound | early-bound
Dim REX As Object 'VBScript_RegExp_55.RegExp
Dim rngData As Range
Dim rngCell As Range

If COLUMN_NUMBER < 2 Then
MsgBox "No... we need to start in at least column 'B'"
Exit Sub
End If

Set REX = CreateObject("VBScript.RegExp")
With REX
.Global = False
'A simple pattern requiring two submatches to get a match.
'The cell cannot start with a space or other characters, so that we
'don't inadvertantly snatch up a 'decimal number' mid-string.
'First submatch is:
'a Word Boundary
'1 or more digits
'a single dot
'1 or more digits
'a Word Boundary
'Second submatch is:
'1 or more characters, anything other than a new line counts.
.Pattern = "^(\b[0-9]+\.[0-9]+\b)(.+)"
End With

With ActiveSheet '<---change to suit
Set rngData = RangeFound(.Range(.Cells(1, COLUMN_NUMBER).Offset(HEADER_ROW_COUNT), .Cells(.Rows.Count, COLUMN_NUMBER)))

If rngData Is Nothing Then
MsgBox "No data..."
Exit Sub
End If

Set rngData = .Range(.Cells(1, COLUMN_NUMBER).Offset(HEADER_ROW_COUNT), .Cells(rngData.Row, COLUMN_NUMBER))
End With

For Each rngCell In rngData.Cells
If REX.Test(rngCell.Value) Then
rngCell.Offset(, -1).Value = Trim$(REX.Execute(rngCell.Value)(0).SubMatches(0))
rngCell.Value = Trim$(REX.Execute(rngCell.Value)(0).SubMatches(1))
End If
Next

End Sub

Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange.Cells(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function


Hope that helps,

Mark

stuartgb100
01-06-2017, 08:44 AM
Mark,

Thanks for your time and trouble.

I'll give it a try, and then do some research on Regular Expressions over the weekend.
Could be very useful to me.

Thanks again.