I have the data in the image I would like to separate. The code in the image doesn't separate once it gets to the semicolon and indentation. I would like to separate the words onto a new sheet so I'm about to search through the array for certain words.
Thanks for the help!
The following code will not only split the data, but also copy over the formatting, which it seems you also wanted. Assumes data is in Column A
Option Explicit
Sub SplitWithFormat()
Dim R As Range, C As Range
Dim i As Long, V As Variant
Set R = Range("a1", Cells(Rows.Count, "A").End(xlUp))
For Each C In R
With C
.TextToColumns Destination:=.Offset(0, 1), DataType:=xlDelimited, _
consecutivedelimiter:=True, Tab:=False, semicolon:=False, comma:=False, _
Space:=True, other:=False
.Copy
Range(.Offset(0, 1), Cells(.Row, Columns.Count).End(xlToLeft)).PasteSpecial xlPasteFormats
End With
Next C
Application.CutCopyMode = False
End Sub
array and why you think the results might not be considered an array. With regard to searching for words, there are a number of different ways to do this, making it quite a broad question. I suggest you formulate a new question, and follow the guidelines laid out in HELP for How do I Ask a Good Question, and also How to create a Minimal, Complete, and Verifiable exampleThis following code will assume you have data in column A. It will put values in column B, C, etc...
Sub find()
Dim s As String
Dim Data As Variant
Dim i As Integer
NumRows = ActiveSheet.Range("A1048576").End(xlUp).Row
s = ActiveCell.Value
Data = Split(s, " ")
For i = 0 To NumRows
Data = Split(Cells(i + 1, 1), " ")
x = 2
For j = 0 To UBound(Data)
Cells(i + 1, x).Value = Data(j)
x = x + 1
Next j
Next i
End Sub
The following code will work for an array of size 100, you can modify it to a higher value, or use a dynamic array with REDIM.
Sub find()
Dim s As String
Dim Data(100) As Variant
Dim i As Integer
For i = 1 To Range("A1").End(xlDown).Row
Cells(i, 1).Font.Underline = True
Cells(i, 2).Value = FindWord(Cells(i, 1), 2) ' change 2 to whatever word position in the original string you want to copy to the right column
Next i
End Sub
' And I added this function
Function FindWord(Source As String, Position As Integer)
Dim cell_strarr() As String
cell_strarr = Split(Source, " ")
strWordCount = UBound(cell_strarr)
If strWordCount < 1 Or (Position - 1) > strWordCount Or Position < 0 Then
FindWord = ""
Else
FindWord = cell_strarr(Position - 1)
End If
End Function
Function FindWord(Source As String, Position As Integer)