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


"Dan" wrote in message
...
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