Announcement

Collapse
No announcement yet.

Unconfigured Ad Widget

Collapse

Move Data From One Column To Multiple Columns

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Move Data From One Column To Multiple Columns

    I am trying to move information that is pulled from a database to look cleaner and easier to read. All of the information exports out into column A only. The attachment is a brief example of what it looks like, and what Iím trying to get it to look like.

    There are a couple thousand sets of information, and their much longer. Each one has 58 lines plus the blank separator row.

    I have some basic experience with formulas and macros, but I havenít had any luck trying to manipulate any of them to give me the information the way I have shown. I would prefer to not have to manually type or cut and past the information in if possible.

    Thanks to anyone who can assist.
    Attached Files

  • #2
    Re: Mov Data From One Column To Multiple Columns

    Hi

    I know it is not to pretty but it will do the trick
    Code:
    Sub arrange_csv()
    
    'Remove }
        rowcount = [A:IV].Find("*", [A:IV].Item(1, 1), , , _
        xlByRows, xlPrevious).Row    'ex 54
        Range("A" & rowcount + 1).Select
        rangecount = rowcount
        ActiveCell.FormulaR1C1 = "=COUNTIF(R[-" & rangecount & "]C:R[-1]C,""*}*"")"
        compte = ActiveCell.Value
        For i = 0 To compte
            Cells.Find(What:="*}*", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False).Activate
            ActiveCell.EntireRow.Delete
            ActiveCell.Offset(rowoffset:=1, columnoffset:=0).Activate
        Next
    
        'Remove text
        rowcount = [A:IV].Find("*", [A:IV].Item(1, 1), , , _
        xlByRows, xlPrevious).Row    'ex 54
        Range("A" & rowcount + 1).Select
        rangecount = rowcount
        ActiveCell.FormulaR1C1 = "=COUNTIF(R[-" & rangecount & "]C:R[-1]C,""*text*"")"
        compte = ActiveCell.Value
        For i = 0 To compte
            Cells.Find(What:="*text*", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False).Activate
            ActiveCell.EntireRow.Delete
            ActiveCell.Offset(rowoffset:=1, columnoffset:=0).Activate
        Next
        'header
        Range("B1").Select
        ActiveCell.FormulaR1C1 = "First_Name"
        Range("C1").Select
        ActiveCell.FormulaR1C1 = "Last_Name"
        Range("D1").Select
        ActiveCell.FormulaR1C1 = "Address"
        Range("E1").Select
        ActiveCell.FormulaR1C1 = "Phone"
        Range("E3").Select
        'First_name
        rowcount = [A:IV].Find("*", [A:IV].Item(1, 1), , , _
        xlByRows, xlPrevious).Row    'ex 54
        Range("A" & rowcount + 1).Select
        rangecount = rowcount
        ActiveCell.FormulaR1C1 = "=COUNTIF(R[-" & rangecount & "]C:R[-1]C,""*FIRST_NAME*"")"
        compte = ActiveCell.Value
        ActiveCell.ClearContents
        For i = 1 To compte
            Cells.Find(What:="*FIRST_NAME*", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False).Activate
            what_row = ActiveCell.Row
            first_name = ActiveCell.Value
            a = InStr(1, first_name, """")
            b = Trim(first_name)
            b = Len(first_name)
            c = b - (a)
            d = Mid(first_name, a + 1, c - 1)
            rowcount = Cells(Cells.Rows.Count, "b").End(xlUp).Row
            Range("b" & rowcount + 1).Select
            ActiveCell.Value = d
            Range("a" & what_row + 1).Select
        Next
        'Last Name
    
        rowcount = [A:IV].Find("*", [A:IV].Item(1, 1), , , _
        xlByRows, xlPrevious).Row    'ex 54
        Range("A" & rowcount + 1).Select
        rangecount = rowcount
        ActiveCell.FormulaR1C1 = "=COUNTIF(R[-" & rangecount & "]C:R[-1]C,""*FIRST_NAME*"")"
        compte = ActiveCell.Value
        ActiveCell.ClearContents
        Range("a1").Select
        For i = 1 To compte
            Cells.Find(What:="*LAST_NAME*", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
            False).Activate
            what_row = ActiveCell.Row
            last_name = ActiveCell.Value
            a = InStr(1, last_name, """")
            b = Trim(last_name)
            b = Len(last_name)
            c = b - (a)
            d = Mid(last_name, a + 1, c - 1)
            rowcount = Cells(Cells.Rows.Count, "c").End(xlUp).Row
            Range("c" & rowcount + 1).Select
            ActiveCell.Value = d
            Range("a" & what_row + 1).Select
        Next
        'address
    
    
        rowcount = [A:IV].Find("*", [A:IV].Item(1, 1), , , _
        xlByRows, xlPrevious).Row    'ex 54
        Range("A" & rowcount + 1).Select
        rangecount = rowcount
        ActiveCell.FormulaR1C1 = "=COUNTIF(R[-" & rangecount & "]C:R[-1]C,""*ADDRESS*"")"
        compte = ActiveCell.Value
        ActiveCell.ClearContents
        Range("a1").Select
        For i = 1 To compte
            Cells.Find(What:="*ADDRESS*", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
            False).Activate
            what_row = ActiveCell.Row
            adress = ActiveCell.Value
            a = InStr(1, adress, """")
            b = Trim(adress)
            b = Len(adress)
            c = b - (a)
            d = Mid(adress, a + 1, c - 1)
            rowcount = Cells(Cells.Rows.Count, "d").End(xlUp).Row
            Range("d" & rowcount + 1).Select
            ActiveCell.Value = d
            Range("a" & what_row + 1).Select
        Next
    
        'phone
    
        rowcount = [A:IV].Find("*", [A:IV].Item(1, 1), , , _
        xlByRows, xlPrevious).Row    'ex 54
        Range("A" & rowcount + 1).Select
        rangecount = rowcount
        ActiveCell.FormulaR1C1 = "=COUNTIF(R[-" & rangecount & "]C:R[-1]C,""*PHONE_NUMBER*"")"
        compte = ActiveCell.Value
        ActiveCell.ClearContents
        Range("a1").Select
        For i = 1 To compte
            Cells.Find(What:="*PHONE_NUMBER*", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
            False).Activate
            what_row = ActiveCell.Row
            phone = ActiveCell.Value
            a = InStr(1, phone, """")
            b = Trim(phone)
            b = Len(phone)
            c = b - (a)
            d = Mid(phone, a + 1, c - 1)
            rowcount = Cells(Cells.Rows.Count, "e").End(xlUp).Row
            Range("e" & rowcount + 1).Select
            ActiveCell.Value = d
            Range("a" & what_row + 1).Select
        Next
        'delete column A
        Columns("A:A").Select
        Selection.Delete Shift:=xlToLeft
    End Sub

    Comment


    • #3
      Re: Move Data From One Column To Multiple Columns

      Thank you very much Jetted. this is working great so far. I have come across one minor problem that im sure is easy to fix. I have two items with similar names, such as L_MATCH and L_MATCH_2. If i wanted to just pull the information that is related to L_MATCH it also pulls the information for L_MATCH_2 and puts the information from both in the same column. How can I make it look for only L_MATCH so I only get that information? Otherwise this is working out wonderfully. Thanks for your help so far.

      Comment


      • #4
        Re: Move Data From One Column To Multiple Columns

        Hi,

        Sub TestIt()
        Dim Headings(), Heads As Range

        Headings = Array("FIRST_NAME", "LAST_NAME", "ADDRESS", "PHONE_NUMBER")

        Application.ScreenUpdating = False
        With Columns("A:A")
        .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="=", FieldInfo:=Array(Array(1, 1), Array(2, 1))
        .Replace What:=" ", Replacement:=""
        End With
        [b1] = "temp"
        Range("D1:G1") = Application.Transpose(Application.Transpose(Headings))

        For Each Heads In Range("D1:G1")
        With Range("A1:B" & [a65536].End(xlUp).Row)
        .AutoFilter field:=1, Criteria1:=Heads
        .Offset(1, 1).Resize(.Rows.Count - 1, 1).Copy
        Cells(Rows.Count, Heads.Column).End(xlUp).Offset(1).PasteSpecial xlValues
        .AutoFilter
        End With
        Next

        With Range("D1:G" & [d65536].End(xlUp).Row)
        .Replace What:=" """, Replacement:=""
        .Replace What:="""", Replacement:=""
        End With
        Columns("A:C").Delete
        Columns("A:D").AutoFit
        Application.ScreenUpdating = True
        End Sub


        HTH
        Kris

        ExcelFox

        Comment


        • #5
          Re: Move Data From One Column To Multiple Columns

          Hi Don

          I would go with Kris code much cleaner. I like this site you learn a lot.....

          Thanks
          Denis

          Comment

          Trending

          Collapse

          There are no results that meet this criteria.

          Working...
          X