how to search a string in VBA

[trammy]

In the excel file I have:

123 A5679 REF
A111 ACC
BLOCK 545 A2456
COPY Abbc23

I would like to search for string beginning with "A" and at least 3
numbers following after letter A. Then I want to copy that string to
the new cell.
For example, the first cell, the string I want is A5679
second cell, A111
third cell, A2456
forth cell, there is no string I want
because after letter A, it is not a number.

So in the new sheet, I should have
A5679
A111
A2456

Thanks a lot,

Tammy

 

[Ivan Raiminius]

Hi Tammy,

see help for like operator.

Regards,
Ivan

 

[Ardus Petus]

This example is based on Regular Expressions.

Alt-F11 to get VBE
Tools>References
Tick Microsoft VBScript Regular Expressions 1.0

HTH
--
AP

'-----------------------------------
Sub ExtractRefs()
Const sDestWSName = "Results"
Dim rSource As Range
Dim wsDest As Worksheet
Dim rDest As Range
Dim re As RegExp
Dim mMatch As MatchCollection
Dim i As Long

'Get Results worksheet
'(create if doesn't exist, clear if exists)
On Error Resume Next
Set wsDest = Worksheets(sDestWSName)
On Error GoTo 0
If wsDest Is Nothing Then
Set wsDest = Worksheets.Add
wsDest.Name = sDestWSName
Else
wsDest.UsedRange.ClearContents
End If
Set rDest = wsDest.Range("A1")

Set re = New RegExp
re.Pattern = "A\d{3,}"
re.Global = True

With Worksheets("Sheet1")
For Each rSource In Range( _
.Range("A1"), _
.Cells(Rows.Count, "A").End(xlUp))

Set mMatch = re.Execute(rSource.Value)
For i = 0 To mMatch.Count - 1
rDest.Value = mMatch(i).Value
Set rDest = rDest.Offset(1, 0)
Next i

Next rSource
End With

End Sub
'--------------------------

 

[JE McGimpsey]

One way:

Dim rCell As Range
Dim rDest As Range
Dim nPos As Long
Dim nEnd As Long
Dim sTemp As String
Set rDest = Worksheets("Sheet2").Range("A1")
For Each rCell In Range("A1:A" & _
Range("A" & Rows.Count).End(xlUp).Row)
sTemp = rCell.Text
If sTemp Like "*A###*" Then
nPos = InStr(1, sTemp, "A")
Do While nPos <> 0
If Mid(sTemp, nPos, 4) Like "A###" Then
nEnd = InStr(nPos, sTemp, " ")
If nEnd = 0 Then nEnd = 32767
rDest.Value = Mid(sTemp, nPos, nEnd - nPos)
Set rDest = rDest.Offset(1, 0)
Exit Do
End If
nPos = InStr(nPos + 1, sTemp, "A")
Loop
End If
Next rCell

 

[trammy]

Ardus,
It works just for first row. when it gets into second row, the
rsource.value is empty.
Thanks,
Tammy

 

[Ardus Petus]

Oooops: forgot a . (pediod)

'-----------------
Sub ExtractRefs()
Const sDestWSName = "Results"
Dim rSource As Range
Dim wsDest As Worksheet
Dim rDest As Range
Dim re As RegExp
Dim mMatch As MatchCollection
Dim i As Long

'Get Results worksheet
'(create if doesn't exist, clear if exists)
On Error Resume Next
Set wsDest = Worksheets(sDestWSName)
On Error GoTo 0
If wsDest Is Nothing Then
Set wsDest = Worksheets.Add
wsDest.Name = sDestWSName
Else
wsDest.UsedRange.ClearContents
End If
Set rDest = wsDest.Range("A1")

Set re = New RegExp
re.Pattern = "A\d{3,}"
re.Global = True

With Worksheets("Sheet1")
For Each rSource In .Range( _
.Range("A1"), _
.Cells(Rows.Count, "A").End(xlUp))

Set mMatch = re.Execute(rSource.Value)
For i = 0 To mMatch.Count - 1
rDest.Value = mMatch(i).Value
Set rDest = rDest.Offset(1, 0)
Next i

Next rSource
End With

End Sub
'-------------

 

[trammy]

Thanks Ardus,

But the rsource.value is empty. after the first row

Tammy