VBA Code to Find Value then Parse Data in Selected Cell

[ckhoody]

I need to have a macro that parses the data in the selected cells that contains the "=" value.

Currently, I have two VBA codes.
1. The first (VBA code) works to find all cells with "=" value and is supposed to then parse all data, separated by spaces, in the selected cells into their own column cells. (Screenshot (2)) shows that it selects only the correct cells but (excel macro error1) show what happens when it tries to run the rest of the code in (code 1).
2. The second (code 2) works to parse space separated data into their own column cells while deleting the "=" value. (Screenshot (3)) shows that it does as it should but only on one selected cell. not with the other code.

I want a code that works as if both codes were combined. *Finds ALL cells with "=" value, and parses space separated data of ALL the selected cells into their own column cells while deleting the "=" value.*
Mind you I only want cells with the "equal sign" value not the equal that is in formulas. Ex. so it selects the cell containing: test1 = 5 7 4 5 G but not the cell containing: =sum(A1:A2)

Any help would be appreciated thanks!

VBA Codes

code 1:

Sub macrotest1()

'PURPOSE: Find all cells containing a specified values works to find and select cells with "=" value

Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range

'What value do you want to find (must be in string form)?
fnd = "="

Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell, LookIn:=xlValues)

'Test to see if anything was found
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Else
GoTo NothingFound
End If

Set rng = FoundCell

'Loop until cycled through all unique finds
Do Until FoundCell Is Nothing
'Find next cell with fnd value
Set FoundCell = myRange.FindNext(after:=FoundCell)

'Add found cell to rng range variable
Set rng = Union(rng, FoundCell)

'Test to see if cycled through to first found cell
If FoundCell.Address = FirstFound Then Exit Do

Loop

'Select Cells Containing Find Value not sure if works

rng.Select

'Parse Selected Cells part that causes error i believe and needs to work with code before

Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
"=", FieldInfo:=Array(Array(1, 9), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True

Exit Sub

'Error Handler
NothingFound:
MsgBox "No values were found in this worksheet"

End Sub

Code 2:

Sub macros_parse()

'
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
"=", FieldInfo:=Array(Array(1, 9), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True


End Sub

 

[bbrnx19]

Sub Simples()

'PURPOSE: Find all cells containing a specified values works to find and select cells with "=" value

Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range

'What value do you want to find (must be in string form)?
fnd = "="

Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell, LookIn:=xlValues)

'Test to see if anything was found
If Not FoundCell Is Nothing Then
    FirstFound = FoundCell.Address
Else
    GoTo NothingFound
End If

'Set rng = FoundCell

'Loop until cycled through all unique finds
Do Until FoundCell Is Nothing
    'Find next cell with fnd value
    Set FoundCell = myRange.FindNext(after:=FoundCell)
    
    'Add found cell to rng range variable
    'Set rng = Union(rng, FoundCell)
    
    ' new -----------
    ActiveSheet.Range(FoundCell.Address).TextToColumns _
    Destination:=ActiveSheet.Range(FoundCell.Address), _
    DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=True, OtherChar:="="
    '-------------- new
    
    'Test to see if cycled through to first found cell
    If FoundCell.Address = FirstFound Then Exit Do

Loop

'Select Cells Containing Find Value not sure if works

'rng.Select

'Parse Selected Cells part that causes error i believe and needs to work with code before

'Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
'TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
'Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
'"=", FieldInfo:=Array(Array(1, 9), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
'1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True

Exit Sub

'Error Handler
NothingFound:
MsgBox "No values were found in this worksheet"

End Sub

 

[BSALV]

you want to split on the 1st occurence of "=", but then, the 2nd part, you want to split it further on a space or again on a "=" ?

if there are no xlConstants-specialcells, then you receive an error.

Sub Cell_by_Cell()
     For Each c In ActiveSheet.UsedRange.SpecialCells(xlConstants)     'cells with content which isn't a formula
          If InStr(c.Value, "=") > 0 Then                       'contains a "="
               sp = Split(Split(c.Value, "=", 2)(1), "=")       'split the 2nd part (=after the 1st "=" further on the "="
               c.Offset(, 1).Resize(, UBound(sp) + 1).Value = sp     'copy those parts to the cells at the right
          End If
     Next
End Sub

 

[ckhoody]

Sub Simples()

'PURPOSE: Find all cells containing a specified values works to find and select cells with "=" value

Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range

'What value do you want to find (must be in string form)?
fnd = "="

Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell, LookIn:=xlValues)

'Test to see if anything was found
If Not FoundCell Is Nothing Then
    FirstFound = FoundCell.Address
Else
    GoTo NothingFound
End If

'Set rng = FoundCell

'Loop until cycled through all unique finds
Do Until FoundCell Is Nothing
    'Find next cell with fnd value
    Set FoundCell = myRange.FindNext(after:=FoundCell)
   
    'Add found cell to rng range variable
    'Set rng = Union(rng, FoundCell)
   
    ' new -----------
    ActiveSheet.Range(FoundCell.Address).TextToColumns _
    Destination:=ActiveSheet.Range(FoundCell.Address), _
    DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=True, OtherChar:="="
    '-------------- new
   
    'Test to see if cycled through to first found cell
    If FoundCell.Address = FirstFound Then Exit Do

Loop

'Select Cells Containing Find Value not sure if works

'rng.Select

'Parse Selected Cells part that causes error i believe and needs to work with code before

'Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
'TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
'Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
'"=", FieldInfo:=Array(Array(1, 9), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
'1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True

Exit Sub

'Error Handler
NothingFound:
MsgBox "No values were found in this worksheet"

End Sub

This Code worked great! Thank you