Moving data from rows to columns & adding blank lines

Can anyone help?

I'm after a macro which will search a row from column J onwards. If it finds data in a cell it will add a blank row below the row it's searching in & then paste the data to column D in the new row. It will continue to add new rows & copy the data in to them until it finds a blank cell.

Thanks for your help.

Ian

Ian

Can we get a little more information? Generally this would be approached from the bottom up (The last row), please bear this in mind when giving the additional info. (Finding the last row is not an issue in code)

1. "If it finds data in column J onward" To what column? (XL2007 has 16,000+ columns)
2. "It continues until it finds a blank row" Will this still work from the bottom or is your request to add rows until the end of the data?

Please elaborate a little if you can

Taking a punt at it

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long

    With Application
        
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    With ActiveSheet
        
        LastRow = .Cells(.Rows.Count, "J").End(xlUp).Row
        For i = LastRow To 1 Step -1
        
            .Rows(i + 1).Insert
            .Cells(i, "J").Cut .Cells(i, "D")
        Next i
        
    End With
    
    With Application
        
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    
End Sub

Nick,

In reply to your questions;

1. Slight miswording, I should have said that  it continues until it finds a blank cell.

2. The number of cells which contain information in the row will vary from row to row. Hence I had envisioned that rows would be added until the end of the data.

Thanks Ian.

Bob,

I've given this a run. It added the new rows but didn't paste the data to column D.

Cheers,

Ian

Ian,

It did in my tests. I cut the value from column J and insert it in column D. This line does it

.Cells(I, "J").Cut .Cells(i, "D")

Bob,

Sorry slight misunderstanding. The data from Cell J needs to be copied to Cell D in a new row below the original one.i.e. the original data in Cell D wil not be over written. This process need to be repeated for any data in subsequent cells on the original row. i.e. the original row of data will become a column.

What code would I need to add to allow this to happen.

Regards,

Ian

Can you type in a small before and after example to show whta you mean, including any data that may get moved by this code.

Bob

We'll see if we get an example but maybe it's just

.Cells(I, "J").Cut .Cells(i + 1, "D")

Nick, Bob,

.Cells(I, "J").Cut .Cells(i + 1, "D") worked for the first cell.

The spreadsheet currently look like this:-

A1 B1 C1 8523 E1 F1 G1 H1 116 125 4568 15

A2 B2 C2 4875 E2 F2 G2 H2 485 784 695

I want to change it to look like this:-

A1 B1 C1 8523 E1 F1 G1 H1 116 125 4568 15

              116

               125

              4568

              15

  A2 B2 C2 4875 E2 F2 G2 H2

                 485

                 784

                 695

The number of cells to be moved varies from zero to several tens.

I hope this clarifies things.

Regards,

Ian

OOPs,

The modified spreadsheet should look like this,

A1 B1 C1 8523 E1 F1 G1 H1 

              116

               125

              4568

              15

  A2 B2 C2 4875 E2 F2 G2 H2

                 485

                 784

                 695

Ian

Ian

Not sure about Bob, but I am still confused. If you reply and go to the options tab, you can upload an excel file showing how the data is and how you want it. That may be simpler...we will get there

I think I get it

Public Sub ProcessData()
Dim i As Long, j As Long
Dim LastRow As Long
Dim LastCol As Long

    With Application
        
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    With ActiveSheet
        
        LastRow = .Cells(.Rows.Count, "I").End(xlUp).Row
        For i = LastRow To 1 Step -1
        
            LastCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
            If LastCol >= 9 Then
            
                .Rows(i + 1).Resize(LastCol - 8).Insert
                For j = 9 To LastCol
                
                    .Cells(i + j - 8, "D").Value = .Cells(i, j).Value
                Next j
            End If
        Next i
        
    End With
    
    With Application
        
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    
End Sub

Bob,

This worked great.

Thank you  for your help.

Are there any books on VBA programming for Excel you would recommend?

Ian

I guess you could look at John Walkenbach's books, VBA for Dummies, or Excel VBA Power Programming.

Can't say I have ever looked at either, but John is the leading author in the Excel field.