Need help with macro for converting data

anyone have know how to convert the following source data that looks like this:

5105473, 5105474, 5105475 batch 12/21/2012 187836




where 5105473, 5105474, 5105475 is in column A, batch is in column B, 12/21/2012 is in column C and 187836 is in column D


goal is to return 3 rows and 4 columns that look like this:

5105473 batch 12/21/2012 187836
5105474 batch 12/21/2012 187836
5105475 batch 12/21/2012 187836

needs to be dynamic, values in column A can vary 2-20 values
total number of rows can also vary

thanks in advance

Here's a quick suggestion:

Sub dataFixing()
Dim i As Integer
Dim exRow As Integer
Dim splitString As Variant
ThisWorkbook.Sheets("Sheet1").Activate
i = 1
exRow = 1
Do
    splitString = Split(Range("A" & i).Value, ",")
    For Each dString In splitString
        Sheets("Sheet2").Cells(exRow, 1) = dString
        Sheets("Sheet2").Cells(exRow, 2) = Sheets("Sheet1").Cells(i, 2)
        Sheets("Sheet2").Cells(exRow, 3) = Sheets("Sheet1").Cells(i, 3)
        Sheets("Sheet2").Cells(exRow, 4) = Sheets("Sheet1").Cells(i, 4)
        exRow = exRow + 1
    Next dString
i = i + 1
Loop While Cells(i, 1) <> ""

End Sub

sullivan372,

Thanks for the code, I follow the logic but when I try to execute the macro it doesn't do anything. Any suggestions?

Sorry for the delayed response - The first things that come to mind are:
-You need to rename the sheets in the code to whatever yours are named
-Your first row is blank meaning the loop only executes once, on nothing

Check these things and let me know if you had already solved it. Otherwise, it would be easiest if you can post your file, so I can test it directly.

Thanks for getting back to me. I did replace the tab in the the macro and there's not a blank row first. The file I'm working with is quite large so I just included a sample section of it. Let me know if you can can get it to work.

Originally Posted by s4driver

Thanks for getting back to me. I did replace the tab in the the macro and there's not a blank row first. The file I'm working with is quite large so I just included a sample section of it. Let me know if you can can get it to work.

Here's another:

Sub s4driver()
Dim lr As Long
Dim x As Long
Dim s As String

s = Left(Range("A2"), 7)

Do Until Range("A2") = s

Range("A1").EntireRow.Insert xlDown
Range("A1").Value = Range("A3").Value
Range("A1").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
x = 1

Do Until ActiveCell.Value = ""

    ActiveCell.Offset(, 1).Select
    
    x = x + 1
    
Loop

Range(Cells(1, 1), Cells(1, x - 1)).Copy
Range("A" & Rows.Count).End(3)(2).PasteSpecial Transpose:=True

lr = Cells(Rows.Count, 1).End(xlUp).Row

Range("B" & Rows.Count).End(3)(2).Resize(x - 1).Value = Range("B3").Value
Range("C" & Rows.Count).End(3)(2).Resize(x - 1).Value = Range("C3").Value
Range("D" & Rows.Count).End(3)(2).Resize(x - 1).Value = Range("D3").Value

Range("A1").EntireRow.Delete xlUp
Range("A2").EntireRow.Delete xlUp

Loop

End Sub

Mike,


That code works. How can I modify to have the output on another tab so the source data remains intact?

Works perfect. Problem solved.

Thanks for all your help...