Shifting Data Right Within A Range

[Guest]

I needed a macro to shift data within a range incrementally to the left, one column at a time. The code below was provided by Wouter HM, for which I am extremely grateful.

=========================================
Sub ShiftLeftInRange()
Dim intCol As Long
Dim celLoop As Range
'
'determen the last used column number
intCol = Range("testRange").Columns.Count + Range("testrange").Column - 1

For Each celLoop In Range("testRange")
If celLoop.Column < intCol Then
' Shift cells witnin range 1 column to the left
celLoop.Value = celLoop.Offset(0, 1).Value
Else
' clear cel in last used column
celLoop.ClearContents
End If
Next
End Sub
=========================================

The above code works great. BUT...

1. How do I also get these same values to shift to the right? And

2. After selecting either a “right shift†or “left shift†of data, how can I loop through a list of desired ranges (about 10 in total, all of which are "range named") in my workbook (containing about 7 worksheets) that I need to apply this procedure to?

Can anyone help me finish my task?

Thank you very much in advance,
Dan

 

[Frank Kabel]

Hi
for a right shift you may use the following:
Sub ShiftRightInRange()
Dim start_col As Integer
Dim end_col As Integer
Dim start_row As Long
Dim end_row As Long
Dim col_loop As Integer
Dim row_loop As Long
Dim rng As Range

Set rng = Selection
start_col = rng.Column
end_col = start_col + rng.Columns.Count - 1
start_row = rng.Row
end_row = start_row + rng.Rows.Count - 1

For col_loop = end_col To start_col Step -1
For row_loop = start_row To end_row
If col_loop = start_col Then
Cells(row_loop, col_loop).ClearContents
Else
Cells(row_loop, col_loop + 1).Value = Cells(row_loop,
col_loop).Value
End If
Next row_loop
Next col_loop
End Sub


This uses the current selection to shift values

 

[Tom Ogilvy]

You appear to be eliminating the first column of values with the shift left
code. If you shifted right, would you want to eliminate the last column of
values in the range and make the first column Blank? This is the mirror
behavior to your current code. If so, this give a shift left and shift
right procedure and an example of how to call them with a List of named
ranges.

Sub ShiftRanges()
Dim v as Variant
Dim i as Long
v = Array("Nm1", "Nm2", "Nm3", "Nm4", "Nm5", "Nm6")
For i = LBound(v) To UBound(v)
If i Mod 2 = 0 Then
ShiftRightInRange ThisWorkbook.Names(v(i)).RefersToRange
Else
ShiftLeftInRange ThisWokrbook.Names(v(i)).RefersToRange
End If
Next
End Sub


Sub ShiftRightInRange(rng As Range)
Dim intCol As Long
Dim celLoop As Range
Dim colLast As Long, colFirst As Long
Dim rwLast As Long, rwFirst As Long
Dim i As Long, j As Long
'
'determine the last used column number
colLast = rng.Columns(rng.Columns.Count).Column
colFirst = rng(1).Column
rwLast = rng.Rows(rng.Rows.Count).Row
rwFirst = rng(1).Row
Debug.Print colLast, colFirst, rwLast, rwFirst
If colLast = colFirst Then
rng.ClearContents
Else
For j = colLast To colFirst Step -1
For i = rwFirst To rwLast
Set celLoop = rng.Parent.Cells(i, j)
If celLoop.Column > colFirst Then
' Shift cells witnin range 1 column to the rigth
celLoop.Value = celLoop.Offset(0, -1).Value
Else
' clear cel in last used column
celLoop.ClearContents
End If
Next i
Next j
End If
End Sub

Sub ShiftLeftInRange(rng As Range)
Dim intCol As Long
Dim celLoop As Range
Dim colLast As Long, colFirst As Long
Dim rwLast As Long, rwFirst As Long
Dim i As Long, j As Long
'
'determine the last used column number
colLast = rng.Columns(rng.Columns.Count).Column
colFirst = rng(1).Column
rwLast = rng.Rows(rng.Rows.Count).Row
rwFirst = rng(1).Row
If colLast = colFirst Then
rng.ClearContents
Else
For j = colFirst To colLast
For i = rwFirst To rwLast
Set celLoop = rng.Parent.Cells(i, j)
If celLoop.Column < colLast Then
' Shift cells witnin range 1 column to the rigth
celLoop.Value = celLoop.Offset(0, 1).Value
Else
' clear cel in last used column
celLoop.ClearContents
End If
Next i
Next j
End If
End Sub





--
Regards,
Tom Ogilvy

I needed a macro to shift data within a range incrementally to the left,

one column at a time. The code below was provided by Wouter HM, for which I
am extremely grateful.

=========================================
Sub ShiftLeftInRange()
Dim intCol As Long
Dim celLoop As Range
'
'determen the last used column number
intCol = Range("testRange").Columns.Count + Range("testrange").Column - 1

For Each celLoop In Range("testRange")
If celLoop.Column < intCol Then
' Shift cells witnin range 1 column to the left
celLoop.Value = celLoop.Offset(0, 1).Value
Else
' clear cel in last used column
celLoop.ClearContents
End If
Next
End Sub
=========================================

The above code works great. BUT...

1. How do I also get these same values to shift to the right? And

2. After selecting either a "right shift" or "left shift" of data, how can

I loop through a list of desired ranges (about 10 in total, all of which are
"range named") in my workbook (containing about 7 worksheets) that I need to
apply this procedure to?