CODEWITHSUNDEEP
excelvbastringloopsextract
W.Jansen
W.Jansen

Reputation: 5

Is there a fix for my string extraction code?

I am trying to extract a substring which has a random position from different strings. The substing is not a fixed value but a "T" and then four numberals e.g. T6000.

Please see this image.

As you can see in this image there are a number of machines names where most of them contain a T number. The T number is also different in almost all of the cases. The column of the machines names is "E". First number (T6000) is in E16, last is in E25.

Using my code: 

For Ipattern = 16 To NumofMachines + 15 Step 1
    TNUMcell = Dsht.Range("E" & Ipattern).Value
    'Verify if string contains a Tnum
    TNUMLikeBoolean = TNUMcell Like "*T###*"

    If TNUMLikeBoolean = True Then
        Do Until TNUMdone = True
            TNUMchar1 = InStr(TNUMcell, "T") + 1
                TNUMcharV = Mid(TNUMcell, TNUMchar1)
                TNUMchecknum = IsNumeric(TNUMcharV)
                    If TNUMchecknum = True Then
                        Dsht.Range("F" & Ipattern).Value = "T" & Mid(TNUMcell, TNUMchar1, 5)
                        TNUMdone = True
                    End If
        Loop
    Else
        Dsht.Range("F" & Ipattern).Value = "NO T"
    End If
Next Ipattern

It only fills in the first and the last cell of the 'export' range (F16:F25).

I have been searching for an answer quite some time. As I am (obviously) not a VBA expert.

What am I doing wrong? Why is not filling in the other values?

Thanks, Wouter J

Upvotes: 0

Views: 59

Answers (2)

YasserKhalil
YasserKhalil

Reputation: 9538

Try this code

Sub Test()
Dim r As Range, i As Long, c As Long

With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "T\d{4}"

    For Each r In Range("E16", Range("E" & Rows.Count).End(xlUp))
        c = 6
        If .Test(r.Value) Then
            For i = 0 To .Execute(r.Value).Count - 1
                Cells(r.Row, c).Value = .Execute(r.Value)(i)
                c = c + 1
            Next i
        End If
    Next r
End With
End Sub

Upvotes: 4

Martin
Martin

Reputation: 16423

The problem is with your variable TNUMdone.

This is set to True on the first iteration of the loop and then never again set to False, so this code after Do Until TNUMdone = True never runs again.

At the start of your loop, just set TNUMdone to False and it should work:

For Ipattern = 16 To NumofMachines + 15 Step 1
    TNUMdone = False
    TNUMcell = Dsht.Range("E" & Ipattern).Value
    ...

Upvotes: 1

Related Questions