If Cell Contains Specific Character


  • I have searched the interweb high and low for the answer to my question with no avail.

    I know the column I want to examine.  I have a loop to find the last row.  I need to check the contents of a cell and see if it contains a ','.  If it does, I need to split the cell and do fun stuff with it from there.  The cells will contain either 'x:xx' or 'x min, x sec'

    Thank you so much!

    Friday, December 28, 2007 1:44 AM

All replies


    Here is a small code where I copy based on comma and


    Code Block

    Sub Copy_Based_On_comma()

        Dim oWB1 As Workbook
        Dim oWB2 As Workbook
        Dim bRet As Boolean
        Set oWB1 = ActiveWorkbook
        Set oWB2 = Workbooks.Add
        Dim i1 As Long
        Dim i2 As Long
        Dim arCommaAdd() As String
        Dim iRow
        bRet = FindAll(",", oWB1.Sheets(1), "A:A", arCommaAdd)
        i2 = 1
        If bRet = True Then
            For i1 = 1 To UBound(arCommaAdd)
                i2 = i2 + 1
                iRow = Right(arCommaAdd(i1), Len(arCommaAdd(i1)) - InStrRev(arCommaAdd(i1), "$"))
                oWB1.Sheets(1).Rows(iRow).EntireRow.Copy Destination:=oWB2.Sheets(1).Range("A" & i2)
            Next i1
        End If
    End Sub



    Try if the above suits you in some way


    Code Block


    Function FindAll(ByVal sText As String, ByRef oSht As Worksheet, ByRef sRange As String, ByRef arMatches() As String) As Boolean

    ' --------------------------------------------------------------------------------------------------------------
    ' FindAll - To find all instances of the given string and return the row numbers.
    '           If there are not any matches the function will return false
    ' --------------------------------------------------------------------------------------------------------------
    On Error GoTo Err_Trap

    Dim rFnd As Range                       ' Range Object
    Dim iArr As Integer                     ' Counter for Array
    Dim rFirstAddress                       ' Address of the First Find

    ' -----------------
    ' Clear the Array
    ' -----------------
    Erase arMatches
    Set rFnd = oSht.Range(sRange).Find(What:=sText, LookIn:=xlValues, LookAt:=xlPart)
    If Not rFnd Is Nothing Then
        rFirstAddress = rFnd.Address
        Do Until rFnd Is Nothing
           iArr = iArr + 1
           ReDim Preserve arMatches(iArr)
           arMatches(iArr) = rFnd.Address  ' rFnd.Row           '  Store the Row where the text is found
           Set rFnd = oSht.Range(sRange).FindNext(rFnd)
           If rFnd.Address = rFirstAddress Then Exit Do  ' Do not allow wrapped search
        FindAll = True
        ' ----------------------
        ' No Value is Found
        ' ----------------------
         FindAll = False
    End If

    ' -----------------------
    ' Error Handling
    ' -----------------------
    If Err <> 0 Then
        MsgBox Err.Number & " " & Err.Description, vbInformation, "Find All"
        FindAll = False
        Exit Function
    End If
    End Function






    Friday, December 28, 2007 9:05 AM