vba code to split cells that contain "*" and do nothing with cells that do not contain "*"

[Maritza]

Hello,

This is my first post here so I hope it will go well.
I have learned to write macro's via the internet which is based on copying and adjusting codes that i find on forums like this and this works perfectly fine. However I am stuck on a certain point right now and can't seem to get it to work.

I want to split one cell into two cells before and after the asterisk.
so for instance abcd123*def456 will become abc123 and def456 in adjacent columns. This works perfectly fine (see my code below).

Sub separate cells()
Dim rngBAs Range    Dim rng As Range
    Dim SH As Worksheet
    Set SH = ActiveSheet
    Set rngB = SH.Range("F2:F" &SH.Range("F" & SH.Rows.Count).End(xlUp).Row)
    For Each rng In rngB
            splitVals = Split(rng.Value,"*")
        totalVals = UBound(splitVals)
        Range(Cells(rng.Row, rng.Column + 1),Cells(rng.Row, _
                rng.Column + 1 + totalVals)).Value= splitVals
        'Else
        'End If
    Next
End Sub

However, now I want to build an If else function in there.
When there is no asterisk "*" in the cell, then I do not want the macro to split the cell (because later I want to filter on the splitted cells).
So I need a code that does something like: If there is an asterisk in the cell, then do my code, else do nothing. I tried to add the lines below, before the splitvalls function and when I run it do not get an error but the cells are also not splitted anymore.

'If InStr(1, "F2","*", 1) Then

'If (cell.Value) = "*" Then​

<strike></strike>
Thanks in advance

<strike></strike><strike></strike>

 

[Trebor76]

Hi Maritza,

Welcome to MrExcel!!

Here's two similar ways to do the job:

Sub Macro1()

    Dim rngMyCell As Range
    Dim strSplitVals() As String
    Dim i As Integer
    
    Application.ScreenUpdating = False
    
    For Each rngMyCell In ActiveSheet.Range("F2:F" & ActiveSheet.Range("F" & ActiveSheet.Rows.Count).End(xlUp).Row)
        If InStr(rngMyCell, "*") > 0 Then
            strSplitVals = Split(rngMyCell.Value, "*")
            For i = LBound(strSplitVals) To UBound(strSplitVals)
                rngMyCell.Offset(0, i + 1) = strSplitVals(i)
                rngMyCell.Offset(0, i + 1) = strSplitVals(i)
            Next i
        End If
    Next rngMyCell
    
    Application.ScreenUpdating = True

End Sub
Sub Macro2()

    Dim rngMyCell As Range
    Dim strSplitVals() As String
        
    Application.ScreenUpdating = False
    
    For Each rngMyCell In ActiveSheet.Range("F2:F" & ActiveSheet.Range("F" & ActiveSheet.Rows.Count).End(xlUp).Row)
        If InStr(rngMyCell, "*") > 0 Then
            strSplitVals = Split(rngMyCell.Value, "*")
            rngMyCell.Offset(0, 1) = strSplitVals(0)
            rngMyCell.Offset(0, 2) = strSplitVals(1)
        End If
    Next rngMyCell
    
    Application.ScreenUpdating = True

End Sub

As the second macro doesn't loop through the array it's probably the preferred but with only two items performance will be very similar (if not the same) between the two.

Hope that helps,

Robert

 

[Maritza]

Thank you so much Robert,

these both work great!
Have a nice day

 

[Rick Rothstein]

Here is another macro that you can consider...

[table="width: 500"]
[tr]
	[td]Sub SplitOnAsterisk()
  With Range("F2", Cells(Rows.Count, "F").End(xlUp))
    .TextToColumns Range("G2"), xlDelimited, , , False, False, False, False, True, "*"
    .Offset(, 2).SpecialCells(xlBlanks).Offset(, -1).Resize(, 1).Clear
  End With
End Sub[/td]
[/tr]
[/table]

 

[Trebor76]

You're welcome

Make sure to also try Rick's nifty solution too