Shifting Data Right Within A Range
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
--
Regards
Frank Kabel
Frankfurt, Germany
Dan wrote:
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
|