Reputation: 237
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
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.
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
Upvotes: 2