*UPDATE* Rows of data to Columns of data *UPDATE*

Thanks for the help so far, thou a slight change......

So far the VBS works fine BUT needs to be altered, something a little more advanced.
it was quite easy to understand how the VBS pulls the data but how can it skip a column of data and a column to add the number "000" to the front of the accountID.???

new test excel file attached.

thanks once again!!!
_lex

-------------------------------------------------------------------------------------------------------------
Hi all,

Such a wonderful site here,
but for the life of me, i can not work out how to setup a Macro or VBS to convert my simple rows of data to making it columns of data.

Problem is:
a) program scans 3x fields of data in (per page), then out puts it to a excel file.
b) each field is on a different row i.e. name\date\code.
c) each other page continues after the last row.
d) 100 pages are scanned in.

Question being, is there a easy way to output this data so it reads\shows in Columns rather than Rows.

Any bit of help would go along way!

Attached is a dummy file which shows the way the data is entered and how it should look like in the end.

thanks for your time!

Hi

The above can be obtained using formulas.

E1: =IF((ROW()-1)*3>=COUNTA(A:A),"",OFFSET($A$1,(ROW()-1)*3,0))
F1: =IF(E1="","",OFFSET($A$1,((ROW()-1)*3)+1,0))
G1: =IF(E1="","",OFFSET($A$1,((ROW()-1)*3)+2,0))

Copy down to match the relevant data.

If you do really need a macro then try

Sub aaa()
  outrow = 1
  For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row Step 3
    Cells(outrow, "E").Value = Cells(i, 1).Value
    Cells(outrow, "F").Value = Cells(i + 1, 1).Value
    Cells(outrow, "G").Value = Cells(i + 2, 1).Value
    outrow = outrow + 1
  
  
  Next i
  
End Sub

HTH

rylo

Hello a6ela,

Here is an automated VBA solution. The macro below copies the data in column "A" three rows at a time to columns "E:G" as single rows. A button has been added to the worksheet to run the macro.

Sub RowsToColumns()

  Dim Cell As Range
  Dim Data() As Variant
  Dim N As Long, R As Long
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Wks As Worksheet
  
    Set Wks = Worksheets("Sheet1")
    
    Set Rng = Wks.Range("A1")
    Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
    Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Wks.Range(Rng, RngEnd))
    
    ReDim Data(1 To Rng.Rows.Count, 1 To 3)
    
      For R = 1 To Rng.Rows.Count Step 3
        N = N + 1
        Data(N, 1) = Rng.Item(R)
        Data(N, 2) = Rng.Item(R + 1)
        Data(N, 3) = Rng.Item(R + 2)
      Next R
      
    Wks.Range("E1:G1").Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
      
End Sub

Hi
Apply this code to attached sample file, if you find this to be working then you can make necessary changes in your original file.

Sub R2C()
Dim i As Integer               'Captures Number of Rows
Dim j As Integer                'for each row loop has to run for three times as Each set is of three columns data
Dim Rw As Integer            ' Row in which data is to be displayed
Dim Co As Integer            'Column in which data is to be displayed

Rw = 10
i = 1
    While i <= Selection.Rows.Count 'You need to select the data area 1st then execute the macro.
    Co = 5
            For j = 1 To 3
            ActiveSheet.Cells(Rw, Co).Value = ActiveSheet.Cells(i, 1).Value
                    Co = Co + 1
                    i = i + 1
            Next
    Rw = Rw + 1
    Wend
MsgBox "Done"
End Sub

Hope this helps..

Hello a6ela,

You will need to give me an example of the problem or post an updated workbook that has the problem.

Hello a6ela,

Here is the revised macro. It now adds a "000" prefix to all the account IDs. The columns have been changed to "J,L,N,O". Here is the code that has been added to the attached workbook.

Sub RowsToColumns()

  Dim Cell As Range
  Dim N As Long, R As Long
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Wks As Worksheet
  
    N = 2
    Set Wks = Worksheets("Sheet1")
    
    Set Rng = Wks.Range("A1")
    Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
    Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Wks.Range(Rng, RngEnd))
    
    Wks.Columns("J").Cells.NumberFormat = "@"
    
      For R = 1 To Rng.Rows.Count Step 4
        Wks.Cells(N, "J") = "000" & Rng.Item(R).Text
        Wks.Cells(N, "L") = Rng.Item(R + 1)
        Wks.Cells(N, "N") = Rng.Item(R + 2)
        Wks.Cells(N, "O") = Rng.Item(R + 3)
        N = N + 1
      Next R
      
    Wks.Columns("J").NumberFormat = "General"
      
End Sub