Macro for organizing excel points

Try this, but I am not sure how well it will work with the amount of data you have.

Sub RowsToColumn()
    Dim RN As Range
    Dim RI As Range
    Dim r As Long
    Dim LR As Long
    Application.ScreenUpdating = False
    Columns(1).Insert
    r = 0
    LR = Range("B" & Rows.Count).End(xlUp).Row
    For Each RN In Range("B22:B" & LR)
        r = r + 1
        For Each RI In Range(RN, Range("XFD" & RN.Row).End(xlToLeft))
            r = r + 1
            Cells(r, 1) = RI
            RI.Clear
        Next RI
    Next RN
    Columns("A:A").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End Sub

Sorry I am a bit puzzled by your last post, the code I posted works from A22 to last row with data. I just retried on a sheet with data from row 22 to 256 and across to column N and it put all the data in column A, starting at A1.

P.S. My code should also have ended "Application.ScreenUpdating = True".

Sub RowsToColumn()
    Dim RN As Range
    Dim RI As Range
    Dim r As Long
    Dim LR As Long
    Application.ScreenUpdating = False
    Columns(1).Insert
    r = 0
    LR = Range("B" & Rows.Count).End(xlUp).Row
    For Each RN In Range("B22:B" & LR)
        r = r + 1
        For Each RI In Range(RN, Range("XFD" & RN.Row).End(xlToLeft))
            r = r + 1
            Cells(r, 1) = RI
            RI.Clear
        Next RI
    Next RN
    Columns("A:A").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
Application.ScreenUpdating = True
End Sub

No,you are correct it doesn't work that way. I took

I need to write a macro to organize this into a single column

literally. I am just about to get some much needed sleep but I will have another look at it tomorrow evening if no-one else has come up with any ideas.

OK, before do anything with this can you just clarify what you want and what I can see?

1) Are you saying that what you are asking for, is to take the data from raw data rows 22 onwards and transpose it in the same location i.e row 22 becomes column A starting at row22, row 23 becomes column B starting at row 22, row 24 becomes column C starting at row 22 e.t.c.

2) then is sheet Oak Flats E11, cell B23 idirectly references raw data cell A22 and so on for the rest of the cells in raw data

Is this correct?
(Probably more questions to follow)

Hi, Thank u so for much. I just checked with the person who needs this task. He wants everything in one column.
I am only working with the Rawdata sheet. So after A22 in one column, A23 starts below it- all in one column. So we don't have to change anything.. A22 has 458 cells. In the final output we will have 458*(78-22+1) number of rows in one column

In the code you gave me, I should be selecting the rows A22-78, copy it? and then run the macro correct?. Feel free to correct me.
Instead can the macro automatically select rows starting from row22 to the #of rows in the sheet...can v use rowcount?

Also, A22-78 has a total of Count:26016. When I run the macro it is only showing me 16453 cells in one column.

Thanku

Originally Posted by schalla

Hi,
On last question. In the code you gave me, I should be selecting the rows and then running the macro. Instead can the macro automatically select rows starting from row22 to the #of rowcount.
Thanku

No you shouldn't be selecting anything the macro already runs from Row 22 to the last used row.That is what this row says

For Each RN In Range("B22:B" & LR)

. It says for each row number starting at row 22 till Last row in column B.

No it should be column B as we have inserted a blank column

Columns(1).Insert

for the data to be transposed to. Selecting the cells makes no difference one way or another to whether the code runs. Afraid I don't know any reason why it wouldn't run without seeing the workbook.
If the code ran with you selecting it then it would have run without you selecting it.

P.S. I the code again on your data in post #5 and it created 26106 entries

Thats not the macro I posted there was no

Set WS = Sheets.Add

in my code

Sub RowsToColumn()
    Dim RN As Range
    Dim RI As Range
    Dim r As Long
    Dim LR As Long
    Dim WS As Worksheet
    Set WS = Sheets.Add
    Application.ScreenUpdating = False
    
    Columns(1).Insert
    r = 0
    LR = Range("B" & Rows.Count).End(xlUp).Row
    For Each RN In Range("B22:B" & LR)
        r = r + 1
        For Each RI In Range(RN, Range("XFD" & RN.Row).End(xlToLeft))
            r = r + 1
            Cells(r, 1) = RI
            RI.Clear
        Next RI
    Next RN
    Columns("A:A").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
Application.ScreenUpdating = True
End Sub

When you added the sheet then the code was working on a blank sheet. The code was

Sub RowsToColumn()
    Dim RN As Range
    Dim RI As Range
    Dim r As Long
    Dim LR As Long
    Application.ScreenUpdating = False
    Columns(1).Insert
    r = 0
    LR = Range("B" & Rows.Count).End(xlUp).Row
    For Each RN In Range("B22:B" & LR)
        r = r + 1
        For Each RI In Range(RN, Range("XFD" & RN.Row).End(xlToLeft))
            r = r + 1
            Cells(r, 1) = RI
            RI.Clear
        Next RI
    Next RN
    Columns("A:A").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
Application.ScreenUpdating = True
End Sub

Try

Sub RowsToColumn()
    Dim RN As Range
    Dim RI As Range
    Dim r As Long
    Dim LR As Long
    Application.ScreenUpdating = False
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Working"
    Sheets("Raw Data").Cells.Copy
    With Sheets("Working")
    .Range("A1").PasteSpecial
    .Rows("1:21").Delete Shift:=xlUp
      Columns(1).Insert
        r = 0
        LR = Range("B" & Rows.Count).End(xlUp).Row
        For Each RN In Range("B1:B" & LR)
            r = r + 1
            For Each RI In Range(RN, Range("XFD" & RN.Row).End(xlToLeft))
                r = r + 1
                Cells(r, 1) = RI
                RI.Clear
            Next RI
        Next RN
        Columns("A:A").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
        Cells(1, 1).Select
        Application.ScreenUpdating = True
    End With
    MsgBox ("Code has finished")
End Sub

and to answer your question;
For Each RI In Range means for every cell in range. RI in this case stands for Row Item but could be called anything
(RN, Range("XFD" & RN.Row).End(xlToLeft)) = RN is Column B row number, XFD is the last column in Excel 2007/10. Basically on each row you are looking at the last cell in the row and then stepping right to left until the last cell with data is found(.End(xlToLeft).

Not much I can do about it I'm afraid, it must be your system resources. I just ran the code on 1033 rows x 111 columns of data and it ran ok (took a little while)

Try this as it might be better if you are struggling with resources, just one warning though you can't have blank cells in the middle of your rows.
Please note also that I didn't write it, I just found it in my old codes.

Sub RowsToColumn2()
    Dim i As Long, k As Long, j As Integer
    Application.ScreenUpdating = False
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Working"
    Sheets("Raw Data").Cells.Copy
    With Sheets("Working")
    .Range("A1").PasteSpecial
    .Rows("1:21").Delete Shift:=xlUp
      Columns(1).Insert
    i = 0
    k = 1
    While Not IsEmpty(Cells(k, 2))
        j = 2
        While Not IsEmpty(Cells(k, j))
            i = i + 1
            Cells(i, 1) = Cells(k, j)
            Cells(k, j).Clear
            j = j + 1
        Wend
        k = k + 1
    Wend
    End With
End Sub