Cut and Paste Values with an Offset

[manthony]

Hi, can someone please help me with a macro. In column AP I have a series of numbers and blank rows. I am looking for a macro that will loop through column AP starting in cell AP2. The macro would skip blank rows and cut and paste the numbers it found into column AQ but would also offset down by the number that was just cut and pasted from column AP to AQ. For example, if I had the number 2 in cell AP2 and the number 5 in cell AP6 then the macro would cut and paste AP2 to AQ4 and AP6 to AQ11 then return back to column AP and cut and paste the next number found. The numbers values and position in column AP are not always the same. Thank you in advance for your help.

 

[baitmaster]

like this?

Sub cutNpaste()
Dim cl As Range
For Each cl In Union(Columns("AP").SpecialCells(xlCellTypeConstants, 23), Columns("AP").SpecialCells(xlCellTypeFormulas, 23)) ' look at only non-blanks
    If cl.Row > 1 Then cl.Cut Destination:=cl.Offset(cl.Value, 1)
Next cl
End Sub

 

[manthony]

like this?

Sub cutNpaste()
Dim cl As Range
For Each cl In Union(Columns("AP").SpecialCells(xlCellTypeConstants, 23), Columns("AP").SpecialCells(xlCellTypeFormulas, 23)) ' look at only non-blanks
    If cl.Row > 1 Then cl.Cut Destination:=cl.Offset(cl.Value, 1)
Next cl
End Sub

Hi,

Thank you for your help I greatly appreciate it. I am getting a type mismatch error on this section of the code "cl.Cut Destination:=cl.Offset(cl.Value, 1)" when I run it. Any ideas on how to fix it?

 

[baitmaster]

what value is in that cell? I suspect it's not an integer hence an error. It could be text, a number formatted as text, or a value with a decimal?

 

[manthony]

what value is in that cell? I suspect it's not an integer hence an error. It could be text, a number formatted as text, or a value with a decimal?

Hi, the value in the cell is from a formula, set to general no specific format. Again, thank you for all the help.

 

[baitmaster]

this version works with integers, decimals, and numbers formatted as text. It contains additional error handling for when there are either no constants or no formulas in the column. It also logs in the Immediate Window, the values being processed so that they can be reviewed later if necessary

Option Explicit
Sub cutNpaste()
Dim cl As Range, i As Long
 
On Error GoTo doFormulas
For Each cl In Columns("AP").SpecialCells(xlCellTypeConstants, 23)
    On Error GoTo 0
    
    If cl.Row > 1 Then
        i = CLng(cl.Value)
        Debug.Print cl.Row, cl, i
        cl.Cut Destination:=cl.Offset(i, 1)
    End If
Next cl

doFormulas:
On Error GoTo endSub
For Each cl In Columns("AP").SpecialCells(xlCellTypeFormulas, 23)
    On Error GoTo 0
    If cl.Row > 1 Then
        i = CLng(cl.Value)
        Debug.Print cl.Row, cl, i
        cl.Cut Destination:=cl.Offset(i, 1)
    End If
Next cl
endSub:
End Sub

 

[manthony]

Awesome, this works perfect. Thank you so much for the help.