How to move a range of data, range is from middle a column to the end of the column, move down 20 rows

[Davefromlondon]

Hi.
I have multiple columns of "similar data".
Every column has the string "additional data" in a cell somewhere below in the column.
this cell can be anywhere from row 12 to row 22, eg in col A the cell containing "additional data" is in A12. In Col B its in row 13 (see my attached image)
below the cell containing "additional data" there can be between 1 and 10 additional cells of data in the column, also containing data.

I seek to move the data in column A, starting at the cell (A12 in my example) containing "additional data" , to include the rest of the data in the column A below this cell (in my attached sheet is yellow highlight) down 20 rows to row 32 to make space (new location for data is highlight blue in my attached sheet) . Then repeat for Col B, ie find the cell containing "additional data" , in this case B39, then move this cell and all cells below down to match the new start row in col A, ie row 32

I can do this easily manually, using my eyes and going column by column , highlight & drag down. I seek to automate with functions or VBA.

 

[mrshl9898]

Hello, try:

Sub move20()

Dim rownum As Long
Dim rownum2 As Long
Dim colnum As Long
Dim lastrow As Long
Dim ws As Worksheet

Set ws = ActiveSheet
colnum = 1
success = 0

Do Until ws.Cells(1, colnum) = ""
    rownum = 1
    lastrow = ws.Cells(ws.Rows.Count, colnum).End(xlUp).Row
    Do Until rownum = lastrow
        If ws.Cells(rownum, colnum) = "additional data:" Then
        success = success + 1
            If success = 1 Then
                rownum2 = rownum + 20
            End If
        ws.Range(ws.Cells(rownum, colnum),ws.Cells(lastrow, colnum)).Copy ws.Cells(rownum2, colnum)
        End If
        rownum = rownum + 1
    Loop
colnum = colnum + 1
Loop

End Sub

 

[Davefromlondon]

wow - quick. let me try and thank you

 

[Davefromlondon]

Hello, try:

Sub move20()

Dim rownum As Long
Dim rownum2 As Long
Dim colnum As Long
Dim lastrow As Long
Dim ws As Worksheet

Set ws = ActiveSheet
colnum = 1
success = 0

Do Until ws.Cells(1, colnum) = ""
    rownum = 1
    lastrow = ws.Cells(ws.Rows.Count, colnum).End(xlUp).Row
    Do Until rownum = lastrow
        If ws.Cells(rownum, colnum) = "additional data:" Then
        success = success + 1
            If success = 1 Then
                rownum2 = rownum + 20
            End If
        ws.Range(ws.Cells(rownum, colnum),ws.Cells(lastrow, colnum)).Copy ws.Cells(rownum2, colnum)
        End If
        rownum = rownum + 1
    Loop
colnum = colnum + 1
Loop

End Sub

unbelievable. wow. worked. oops.. Forgot to say... I seek the original data clearing after it has been moved. what code will do this

 

[mrshl9898]

This should do it.

Sub move20()

Dim rownum As Long
Dim rownum2 As Long
Dim colnum As Long
Dim lastrow As Long
Dim ws As Worksheet

Set ws = ActiveSheet
colnum = 1
success = 0

Do Until ws.Cells(1, colnum) = ""
    rownum = 1
    lastrow = ws.Cells(ws.Rows.Count, colnum).End(xlUp).Row
    Do Until rownum = lastrow
        If ws.Cells(rownum, colnum) = "additional data:" Then
        success = success + 1
            If success = 1 Then
                rownum2 = rownum + 20
            End If
        ws.Range(ws.Cells(rownum, colnum), ws.Cells(lastrow, colnum)).Copy ws.Cells(rownum2, colnum)
        ws.Range(ws.Cells(rownum, colnum), ws.Cells(lastrow, colnum)).ClearContents
        End If
        rownum = rownum + 1
    Loop
colnum = colnum + 1
Loop

End Sub

 

[Davefromlondon]

This should do it.

Sub move20()

Dim rownum As Long
Dim rownum2 As Long
Dim colnum As Long
Dim lastrow As Long
Dim ws As Worksheet

Set ws = ActiveSheet
colnum = 1
success = 0

Do Until ws.Cells(1, colnum) = ""
    rownum = 1
    lastrow = ws.Cells(ws.Rows.Count, colnum).End(xlUp).Row
    Do Until rownum = lastrow
        If ws.Cells(rownum, colnum) = "additional data:" Then
        success = success + 1
            If success = 1 Then
                rownum2 = rownum + 20
            End If
        ws.Range(ws.Cells(rownum, colnum), ws.Cells(lastrow, colnum)).Copy ws.Cells(rownum2, colnum)
        ws.Range(ws.Cells(rownum, colnum), ws.Cells(lastrow, colnum)).ClearContents
        End If
        rownum = rownum + 1
    Loop
colnum = colnum + 1
Loop

End Sub

worked. I have a serious big smile on my face. Please know I'll study the code so I learn. I was a comp sci grad in 1982 and been in sales 30 years and not written 1 line of code till this month, this is fun to re-learn some skills.

 

[mrshl9898]

F8 is your friend to step through the code, good luck.

 

[Davefromlondon]

worked. I have a serious big smile on my face. Please know I'll study the code so I learn. I was a comp sci grad in 1982 and been in sales 30 years and not written 1 line of code till this month, this is fun to re-learn some skills.

apologies, 1 last item. the string "additional data" I notice now is sometimes just "data" . in other words, I seek to move the cells if I find either string. I tried
[ If ws.Cells(rownum, colnum) = "additional data" or "data" Then ] but clearly this synrax is incorrect. Any guidance ?

 

[mrshl9898]

Close.

If ws.Cells(rownum, colnum) = "additional data" or ws.Cells(rownum, colnum) "data" then