johndoe253
johndoe253

Reputation: 237

Finding index of string in string array

enter image description hereenter image description hereenter image description here

This program removes a string from an array to a new sheet. I find the string 'hello' or 'bye' but I also want the string in the index before each of those strings. The string before 'hello' or 'bye' will not always be the same so how can the I use the Index() function?

Sub SplitWithFormat()
    Dim R As Range, C As Range
    Dim i As Long, V As Variant
    Dim varHorizArray As Variant
    Dim rge As Range
    Dim intCol As Integer
   
Set R = Range("d1", Cells(Rows.Count, "d").End(xlUp))
For Each C In R
    With C
        .TextToColumns Destination:=.Range("AD1"), DataType:=xlDelimited, _
        consecutivedelimiter:=True, Tab:=False, semicolon:=True, comma:=False, _
        Space:=True, other:=True, Otherchar:=vbLf

        Set rge = Selection
        varHorizArray = rge
        .Copy
        Range(.Range("AD1"), Cells(.Row, Columns.Count).End(xlToLeft)).PasteSpecial xlPasteFormats
    End With
Next C

Application.CutCopyMode = False

    For intCol = LBound(varHorizArray, 2) To UBound(varHorizArray, 2)
       Debug.Print varHorizArray(1, intCol)
    Next intCol
    
       
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    varHorizArray = Array("bye","hello")
    Set NewSh = Worksheets.Add

    With Sheets("Sheet2").Range("AD1:AZ100")

        Rcount = 0

        For i = LBound(varHorizArray) To UBound(varHorizArray)

            
            Set Rng = .find(What:=varHorizArray(i), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    Rcount = Rcount + 1

                    Rng.Copy NewSh.Range("A" & Rcount)

                    
                    NewSh.Range("A" & Rcount).Value = Rng.Value

                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next i
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Upvotes: 2

Views: 124

Answers (1)

user4039065
user4039065

Reputation:

While the InStr function is typically used to locate a substring within a string, your multiple search terms may be better handled with the Split function.

Option Explicit

Sub stripName()
    Dim rw As Long

    With ActiveSheet
        For rw = 1 To .Cells(Rows.Count, "D").End(xlUp).Row
            .Cells(rw, "A") = Split(Split(.Cells(rw, "D").Value2, ", hello")(0), ", bye")(0)
        Next rw
    End With

End Sub

Note that the search terms use on the split are case-sensitive.

split_names

Addendum for revised question:

Option Explicit

Sub stripName()
    Dim rw As Long, s As String

    With ActiveSheet
        For rw = 1 To .Cells(Rows.Count, "D").End(xlUp).Row
            s = Split(.Cells(rw, "D").Value2, ", bye")(0)
            s = Split(s, ", hello")(0)
            s = Split(Chr(32) & s, Chr(32))(UBound(Split(Chr(32) & s, Chr(32))))
            .Cells(rw, "A") = s
        Next rw
    End With

End Sub

split_names2

Upvotes: 2

Related Questions