none
Extrat/Pull/Seperate text after semicolon using vba in Excel 2010 RRS feed

  • Question

  • So this is a weird one. I cannot use text to columns on this. I tried using and Excel can't recognize the spaces after in the cell.

    The workbook i have is pull from a web source and in column d the contents are wrapped. I don't know how any way to unwrap the text as I've tried multiple ways to get the contents of the cell to split. However, I've moved on to using vba for this function. I figure i can get the text after the semicolons. The code I created set the headers, but by code to pull after the semi colon isn't working. I suspect this is due to the wrapped formatting in the cells. Does anyone know how too or can assist by constructing a better code to pull the data?

                              

    Sub Sepdata()
    '
    'first add the headers

    '
        Dim ws As Workbook
        Set ws = ActiveWorkbook
        ws.Sheets(1).Activate

        ActiveCell.FormulaR1C1 = "Requester Name:"
        Range("O1").Select
        ActiveCell.FormulaR1C1 = "Title of Person Calling:"
        Range("P1").Select
        ActiveCell.FormulaR1C1 = "Vendor Name:"
        Range("Q1").Select
        ActiveCell.FormulaR1C1 = "Vendor Number:"
        Range("R1").Select
        ActiveCell.FormulaR1C1 = "Email Address:"
        Range("S1").Select
        ActiveCell.FormulaR1C1 = "Invoice Number:"
        Range("T1").Select
        ActiveCell.FormulaR1C1 = "Invoice Date:"
        Range("U1").Select
        ActiveCell.FormulaR1C1 = "Invoice Amount:"
        Range("V1").Select
        ActiveCell.FormulaR1C1 = "Purchase Order Number:"
        Range("W1").Select
        ActiveCell.FormulaR1C1 = "Attach File of Invoices in Question:"
        Range("X1").Select
        ActiveCell.FormulaR1C1 = "Detail:"
        Range("Y1").Select

       'now separate after the semicolon too the adjacent row and column
       Dim shortdesc As String

        endrow = Range("a" & Rows.Count).End(xlUp).Row
        'Range(D2).Select
        Do While ActiveCell.Row <> endrow
        For Row = 2 To endrow
        Range("n" & Row).Value = Mid(Range("d" & Row).Value, InStr(1, Range("d" & Row).Value, ";") + 1, Len(Range("d" & Row).Value))
        Next

         Loop


    End Sub

    Thursday, March 2, 2017 7:44 PM

Answers

  • Try

        

    Sub TestMacro2()
        Dim rngC As Range
        Dim v As Variant
        Dim i As Integer

        On Error Resume Next

        For Each rngC In Selection
            v = Split(rngC.Value, Chr(10))
            For i = LBound(v) To UBound(v)

               rngC.Offset(0, i + 1).Value = Application.Trim(Replace(Split(v(i), ":")(1), Chr(160), " "))

            Next i
        Next rngC
    End Sub

    You might want to look at other non-printing characters, too:

    https://support.office.com/en-us/article/Remove-spaces-and-nonprinting-characters-from-text-023f3a08-3d56-49e4-bf0c-fe5303222c9d?ui=en-US&rs=en-US&ad=US&fromAR=1


    Thursday, March 2, 2017 8:35 PM

All replies

  • Select the cells in column D, and run this macro: It is possible, since the source is the internet, that the spaces are character 160s, which would require replacing those with spaces prior to the trim...

        

    Sub TestMacro()
        Dim rngC As Range
        Dim v As Variant
        Dim i As Integer

        On Error Resume Next

       For Each rngC In Selection
            v = Split(rngC.Value, Chr(10))
            For i = LBound(v) To UBound(v)
               rngC.Offset(0, i + 1).Value = Trim(Split(v(i), ":")(1))
            Next i
        Next rngC
    End Sub




    Thursday, March 2, 2017 8:05 PM
  • Hi Bernie, I ran that macro, but the spaces are still there. Thanks for assisting me.

    • Edited by Legzen34 Thursday, March 2, 2017 8:32 PM
    Thursday, March 2, 2017 8:10 PM
  • Try

        

    Sub TestMacro2()
        Dim rngC As Range
        Dim v As Variant
        Dim i As Integer

        On Error Resume Next

        For Each rngC In Selection
            v = Split(rngC.Value, Chr(10))
            For i = LBound(v) To UBound(v)

               rngC.Offset(0, i + 1).Value = Application.Trim(Replace(Split(v(i), ":")(1), Chr(160), " "))

            Next i
        Next rngC
    End Sub

    You might want to look at other non-printing characters, too:

    https://support.office.com/en-us/article/Remove-spaces-and-nonprinting-characters-from-text-023f3a08-3d56-49e4-bf0c-fe5303222c9d?ui=en-US&rs=en-US&ad=US&fromAR=1


    Thursday, March 2, 2017 8:35 PM
  • By the power of Gray Skull! You are a GENIUS! thanks that worked!
    Thursday, March 2, 2017 9:15 PM
  • By the power of Gray Skull! You are a GENIUS! thanks that worked!
    LOL! - Glad to hear it - that's a new one!
    Thursday, March 2, 2017 9:42 PM