move cell values over 2 cells
 

I'm using the code below, which I found here) and this works fine to
delete the row I want, but I want another bit of code that will find a
different value and then move cell values over two cells.

Here's the Delete Row code (this one works very well)

Sub Deleterows()
Dim lastrow As Long, a As Long, b As Long
Application.ScreenUpdating = False
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
For a = lastrow To 2 Step -1
If Cells(a, "b") = "Projected" Then
Rows(a).EntireRow.Delete
End If
Next a
End Sub

Now, I want to find the Word 'Subtotal' in column B, say one is in
cell B80. What I would like is to move what is in Cell C80, D80, E80,
F80, G80, H80, I80 over 2 cells. Then move (what would be the new
cell value from E80 and F80 back to the left one cell. When all is
done cell E80 would then be blank..make sense?

move cell values over 2 cells
 

Hi Rock -

Please clarify. If you move C80-I80 to the right two cells, then move the
new E80 and F80 back to the left one cell, I don't think E80 will be blank
(will it?). I believe the maneuver you describe leaves F80 and C80 blank.

Jay

"Rock" wrote:

I'm using the code below, which I found here) and this works fine to
delete the row I want, but I want another bit of code that will find a
different value and then move cell values over two cells.

Here's the Delete Row code (this one works very well)

Sub Deleterows()
Dim lastrow As Long, a As Long, b As Long
Application.ScreenUpdating = False
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
For a = lastrow To 2 Step -1
If Cells(a, "b") = "Projected" Then
Rows(a).EntireRow.Delete
End If
Next a
End Sub

Now, I want to find the Word 'Subtotal' in column B, say one is in
cell B80. What I would like is to move what is in Cell C80, D80, E80,
F80, G80, H80, I80 over 2 cells. Then move (what would be the new
cell value from E80 and F80 back to the left one cell. When all is
done cell E80 would then be blank..make sense?

move cell values over 2 cells
 

Please try:
Sub MoveSubTs()
Dim lastrow As Long, a As Long
Application.ScreenUpdating = False
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
For a = lastrow To 1 Step -1
If Cells(a, "b") = "Subtotal" Then
Cells(a, "c").Resize(1, 6).Cut Destination:=Cells(a, "e")
Cells(a, "e").Resize(1, 2).Cut Destination:=Cells(a, "d")
End If
Next a
End Sub


"Rock" wrote:

I'm using the code below, which I found here) and this works fine to
delete the row I want, but I want another bit of code that will find a
different value and then move cell values over two cells.

Here's the Delete Row code (this one works very well)

Sub Deleterows()
Dim lastrow As Long, a As Long, b As Long
Application.ScreenUpdating = False
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
For a = lastrow To 2 Step -1
If Cells(a, "b") = "Projected" Then
Rows(a).EntireRow.Delete
End If
Next a
End Sub

Now, I want to find the Word 'Subtotal' in column B, say one is in
cell B80. What I would like is to move what is in Cell C80, D80, E80,
F80, G80, H80, I80 over 2 cells. Then move (what would be the new
cell value from E80 and F80 back to the left one cell. When all is
done cell E80 would then be blank..make sense?

move cell values over 2 cells
 

On Aug 15, 2:48 pm, Jay wrote:
Hi Rock -

Please clarify. If you move C80-I80 to the right two cells, then move the
new E80 and F80 back to the left one cell, I don't think E80 will be blank
(will it?). I believe the maneuver you describe leaves F80 and C80 blank.

Jay



"Rock" wrote:
I'm using the code below, which I found here) and this works fine to
delete the row I want, but I want another bit of code that will find a
different value and then move cell values over two cells.

Here's the Delete Row code (this one works very well)

Sub Deleterows()
Dim lastrow As Long, a As Long, b As Long
Application.ScreenUpdating = False
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
For a = lastrow To 2 Step -1
If Cells(a, "b") = "Projected" Then
Rows(a).EntireRow.Delete
End If
Next a
End Sub

Now, I want to find the Word 'Subtotal' in column B, say one is in
cell B80. What I would like is to move what is in Cell C80, D80, E80,
F80, G80, H80, I80 over 2 cells. Then move (what would be the new
cell value from E80 and F80 back to the left one cell. When all is
done cell E80 would then be blank..make sense?- Hide quoted text -

- Show quoted text -

right, it gets a bit confusing...I was thinking need to move c80:I80
over 3 cells, then E80 and F80 back to the left...leaving F80 blank
and C80 as well. I guess another why would move e80:I80 over 3, then
c80:d80 over 2...something like that. I recorded this step but I
don't know how to apply it or translate to code....

move cell values over 2 cells
 

Rock -

Below is code that moves the 7 cells to the right 2 spaces, then moves two
cells back to the left 1 space. This maneuver leaves C80 and F80 blank as
you describe.

If you start by moving the 7 cells to the right 3 spaces, you will end up
with 3 blank cells in the row no matter what you do. So, the code below lets
you modify the offsets to get the result you desire by trial and error:

Sub ModifySubtotalRows_Ver3()
Dim lastrow As Long, a As Long, b As Long
lastrow = Cells(Rows.Count, "a").End(xlUp).Row

'-------------------------------------
'Rock - modify the offset values in these two statements as needed
offset1 = 2 'number of columns to move C-I to the right
offset2 = 1 'number of columns to move two cells back to the left
'---------------------------------------

For a = lastrow To 2 Step -1
If Cells(a, "b") = "SubTotal" Then
Set anchorCell = Cells(a, "c")
anchorCell.Resize(1, 7).Cut Destination:=anchorCell.Offset(0, offset1)
anchorCell.Resize(1, 2).Cut Destination:=anchorCell.Offset(0, -1 *
offset2)
End If
Next a
End Sub

---
Jay

"Rock" wrote:

right, it gets a bit confusing...I was thinking need to move c80:I80
over 3 cells, then E80 and F80 back to the left...leaving F80 blank
and C80 as well. I guess another why would move e80:I80 over 3, then
c80:d80 over 2...something like that. I recorded this step but I
don't know how to apply it or translate to code....