Search a string within a sheet

[capinss]

Hello!
Probably an easy one for you guys...
I have a table of data and i need to search the table for 8digit numbers, that are beginning with "2" and copy the numbers to the column on the right. A cell can contain multiple numbers with 8 digits.
Thanks in advance.

 

[capinss]

Thank you very much, JB Scotland, your version works great, but there are still a few rows, where there are no results, can you take a look at this?

Excel Workbook
	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
2580	Zil?i ZS	B?rzaines	Valmieras	4240479, 29228034		240479, 29228034		40479, 29228034	29228034;			#####		#####		#VALUE!		#####
ZS

 

[JB_Scotland]

Hi Capinss,

I think you must have copied across into colum T on that row or other problem rows. The T column should have a formula joining up the numbers found. i.e. for row 2580 the formula should be:

=IF(LEN(E2580&G2580&I2580&K2580&M2580&O2580&Q2580&S2580)<>0,LEFT(E2580&G2580&I2580&K2580&M2580&O2580&Q2580&S2580,LEN(E2580&G2580&I2580&K2580&M2580&O2580&Q2580&S2580)-2),"")

Look back at my the previous post and make sure you just copy down, not across.

Cheers

JB

 

[Peter_SSs]

1. Hint for Excel jeanie:

You can use the ‘Analyse range (Forum)’ field near the top left of the Excel jeanie screen to restrict the number of formulas generated. In that field, you can use Ctrl+Click/Drag to select multiple disjoint ranges if required. There is generally no need to display multiple formulas that are basically the same, it just fills up the board.

2. Test your formulas with this data in column D, it didn't seem to work for me.
Zoo Inta Silauniece 92334844, 26404329

 

[GTO]

Greetings capinss,

I took a look at my previous input, and ACK!, it fails in a number of different circumstances.

This should do better, unless of course I have missed/not thought of some possibility.

I did test against Peter's suggestion, as well as a bit of 'made up' data.

Sub FindVals()
Dim _
lRow                    As Long, _
rngToCheck              As Range, _
rCell                   As Range, _
strCell                 As String, _
aStrArray()             As Variant, _
i                       As Integer, _
intFound                As Integer
 
    lRow = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
 
    Set rngToCheck = ActiveSheet.Range("D1:D" & lRow)
 
    For Each rCell In rngToCheck
        ReDim aStrArray(0)
 
        If Not InStr(1, rCell, 2, vbTextCompare) = 0 Then
            strCell = rCell
 
            intFound = InStr(1, strCell, 2, vbTextCompare)
 
            Do While Not intFound = 0
 
                If Len(Mid(strCell, intFound, 8)) = 8 Then
 
                    If Mid(strCell, intFound, 8) Like "2#######" _
                    And Not Mid(strCell, intFound, 9) Like "2########" Then
 
                        aStrArray(UBound(aStrArray())) = _
                            Mid(strCell, intFound, 8)
 
                        ReDim Preserve aStrArray(UBound(aStrArray()) + 1)
                    End If
 
                        strCell = Right(strCell, (Len(strCell) - 7) - intFound)
                        intFound = InStr(1, strCell, 2, vbTextCompare)
                Else
                    Exit Do
                End If
            Loop
 
            If Not UBound(aStrArray()) = 0 Then _
            ReDim Preserve aStrArray(UBound(aStrArray()) - 1)
 
            strCell = vbNullString
 
            If Not aStrArray(0) = Empty Then
                For i = LBound(aStrArray()) To UBound(aStrArray())
                    strCell = strCell & aStrArray(i) & ";"
                Next
 
                strCell = Left(strCell, Len(strCell) - 1)
                rCell.Offset(, 1).Value = strCell
 
            End If
        End If
    Next
End Sub

Hope this helps,

Mark

 

[jindon]

try

Sub test()
Dim a, b(), i As Long, mtch As Object, m As Object
a = Range("d1", Range("d" & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a, 1), 1 To 1)
With CreateObject("VBScript.RegExp")
    .Pattern = "\b(\d{8})\b"
    .Global = True
    For i = 1 To UBound(a, 1)
        If .test(a(i, 1)) Then
            Set mtch = .execute(a(i, 1))
            For Each m In mtch
                temp = tem & "," & m.submatches(0)
            Next
            b(i, 1) = Mid$(temp, 2)
            temp = ""
        End If
    Next
End With
Range("e1").Resize(UBound(b,1)).Value = b
End Sub

 

[JB_Scotland]

Thanks for the Jeanie tip Peter. Regarding the failure of the formula method, I acknowledge it does have its limitations as written.

If an 8 digit number starting with a 2 is not found, the subsequent search string (in the next column) will be one character shorter. Therefore if there are strings within the original search data more than 8 characters long (not numbers) then the search formulas will not find subsequent matches. A soultion would be to extend the number of columns, copying across alternately Result and Remaining Search Data formulas, and adjusting the formula in the last column to join together multiple results.

It all gets a bit unweildy though. I think the macros suggested offer a neater solution.

 

[jindon]

Correction

    .Pattern = "\b(\d{8})\b"

should be

    .Pattern = "\b(2\d{7})\b"

 

[capinss]

Thank you all very much!
The GTO's last version works perfect!
For the jindon's version of code - the code extracts only one number from a cell, if there happens to be two numbers in one cell - it extracts only the last one. But partially works great.. and your last edit, changing the pattern to 7 is wrong, it works with 8
Thanks guys very much, I really appreciate your work involved!
cheers

edit: Jindon's version doesn't change much by editing the pattern line. It also works the same as the starting version - extracting only one number.

 

[GTO]

@Jindon:

Greetings and "Howdy" from the desert (Arizona).

A buddy mentioned that a regular expression might be a ton faster, but I've tried a small RegExp like once or twice, so was a bit too reticent.

Anyways, as very interesting of course I tested right away. I dim'd 'temp' and changed .Pattern as indicated. Unfortunately, with the test data at left, I got the results to the right? (Excel 2000 and a pretty sickly laptop, but I don't think that would effect)

Zoo Inta Silauniece-29334844, 4640429...............29334844
293893, 29345678, 246456g5, 25698754..............2,934,567,825,698,750
29345644, F245666, 244654387, 245645, 26543165..................2,934,564,426,543,160
Zoo Inta Silauniece 92334844, 26404329...............9,233,484,426,404,320

It's way later than this lad should be up, but will definitely look tomorrow.

A good day to all

Mark

 

[jindon]

Then try

.Pattern = "\D(2\d{7})(\D|$)"