Consulting

Results 1 to 8 of 8

Thread: InStr() Option

  1. #1
    VBAX Contributor
    Joined
    Jun 2014
    Posts
    107
    Location

    InStr() Option

    Does anyone know if there is another function like InStr() where it will return the position location of everything found in a string?

    str = "abcabcabcabc"

    val = instr***(str, "b")

    'returns 2,5,8,11

    I know I can create my own but I was wondering if anyone new a function that already exists that can do this.

  2. #2
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    I can't speak for the other 6 + billion souls but AFAIK there is no built-in function that does that. I have my own custom function for that purpose. It will be interesting to see yours.
    Greg

    Visit my website: http://gregmaxey.com

  3. #3
    VBAX Contributor
    Joined
    Jun 2014
    Posts
    107
    Location
    I figured as such but I thought I'd give it a shot. Would be nice though.

  4. #4
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    Unless you just want me to give you a fish, post what you come up with and we can compare.
    Greg

    Visit my website: http://gregmaxey.com

  5. #5
    VBAX Regular
    Joined
    May 2006
    Posts
    27
    Location
    try:
    Function InstrSample4(str1 As String, str2 As String) As Long()
        Dim iPos As Long
        Dim iPos1 As Long
        Dim iPosAll() As Long
        Dim iCount As Long
            
        iPos = InStr(1, str1, str2)
        iPos1 = iPos
        Do While (iPos <> 0)
            iCount = iCount + 1
            ReDim Preserve iPosAll(1 To iCount)
            iPosAll(iCount) = iPos1
            str1 = Mid(str1, iPos + Len(str2))
            iPos = InStr(1, str1, str2)
            iPos1 = iPos1 + Len(str2) + iPos - 1
        Loop
        
        InstrSample4 = iPosAll()
    End Function

    Sub test()
       Dim str As String
       str = "abcabcabcabc"
       Dim val
       val = InstrSample4(str, "b")
       Dim i As Long
       For i = LBound(val) To UBound(val)
          Debug.Print val(i)
       Next
    End Sub
    Last edited by Paul_Hossler; 07-02-2019 at 07:15 AM. Reason: Added CODE tags

  6. #6
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    fanjy,

    Yes, that is one way. Here is another:

    Sub TestFunction()
    Dim strSample As String
    Dim lngIndex As Long
    Dim varRtn
      strSample = "abcabcabcabc"
      varRtn = fcnGetSubStringPosits(strSample, "b")
      If Not IsArrayEmpty(varRtn) Then
        For lngIndex = LBound(varRtn) To UBound(varRtn)
          Debug.Print varRtn(lngIndex)
        Next lngIndex
      End If
    lbl_Exit:
      Exit Sub
    End Sub
    Function fcnGetSubStringPosits(strMain As String, strSub As String) As Long()
    Dim arrParts() As String
    Dim arrPosits() As Long
    Dim lngIndex As Long, lngCalc As Long
      arrParts = Split(strMain, strSub)
      For lngIndex = 0 To UBound(arrParts) - 1
        ReDim Preserve arrPosits(lngIndex)
        arrPosits(lngIndex) = Len(arrParts(lngIndex)) + 1 + lngCalc
        lngCalc = lngCalc + Len(arrParts(lngIndex)) + Len(strSub)
      Next lngIndex
      fcnGetSubStringPosits = arrPosits
    lbl_Exit:
      Exit Function
    End Function
    Public Function IsArrayEmpty(varArray As Variant) As Boolean
    Dim lngLB As Long, lngUB As Long
      If Not IsArray(varArray) Then
        IsArrayEmpty = True
        Exit Function
      End If
      On Error Resume Next
      lngUB = UBound(varArray, 1)
      If (Err.Number <> 0) Then
        IsArrayEmpty = True
      Else
        Err.Clear
        IsArrayEmpty = False
        lngLB = LBound(varArray)
        If lngLB > lngUB Then IsArrayEmpty = True
      End If
    lngLBl_Exit:
      Exit Function
    End Function
    Last edited by Paul_Hossler; 07-02-2019 at 07:14 AM. Reason: Not like Greg to forget CODE tags :-)
    Greg

    Visit my website: http://gregmaxey.com

  7. #7
    VBAX Regular
    Joined
    Jun 2019
    Location
    Wellington
    Posts
    8
    Location
    Just for diversity, I'd do it this way:

    Public Sub FindPositionsTest()
        Const c_testData    As String = "abcdefabcdefaaabbbcccdddeeefffa"
        Const c_findIt      As String = "bc"
    
        Dim arrayMax    As Long
        Dim foundAt     As Long
        Dim positions() As Long
        Dim theIndex    As Long
    
        ' There must be something to find and search
        If LenB(c_findIt) = 0 Or LenB(c_testData) = 0 Then
            Exit Sub
        End If
    
        ' Allocate the maximum # of possible find slots
        arrayMax = Len(c_testData) \ Len(c_findIt)
        ReDim positions(1 To arrayMax)
    
        ' Standard find something in something
        For theIndex = 1 To arrayMax
    
            ' Find what were looking for
            foundAt = InStr(foundAt + 1, c_testData, c_findIt)
            If foundAt = 0 Then
    
                ' Only return those array elements that were assigned values
                If theIndex > 1 Then
                    ReDim Preserve positions(1 To theIndex - 1)
                Else
                    ' Do this so that LBound/UBound dont fail
                    ReDim positions(-1 To -1)
                End If
    
                Exit For
            Else
    
                ' Stash the value
                positions(theIndex) = foundAt
            End If
        Next
    
        ' Dump what we found
        If UBound(positions) > 0 Then
            For theIndex = 1 To UBound(positions)
                Debug.Print positions(theIndex)
            Next
        End If
    End Sub
    Last edited by PeterH_NZ; 06-30-2019 at 08:02 PM.
    Inner Word Limited, Wellington, New Zealand

  8. #8
    VBAX Regular
    Joined
    Jan 2018
    Posts
    55
    Location
    Hi, everyone. Here's the code using regular expression.

    Sub test()
        Dim Match, Matches
        Dim strPattern As String
        Dim strTest As String
        
      
        strTest = "abcabcabcabcabc"
        strPattern = "ca"
        
        With CreateObject("VBScript.RegExp")
            .Pattern = strPattern
            .IgnoreCase = True
            .Global = True
            Set Matches = .Execute(strTest)
        End With
        
        For Each Match In Matches
            Debug.Print Match.FirstIndex + 1
        Next
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •