Option Explicit
Sub Test__Shift_Rows_In_The_Workbook_In_The_Sheet()
Call Shift_Rows_In_The_Workbook_In_The_Sheet(ActiveWorkbook, ActiveSheet.Name, 2)
End Sub
Sub Shift_Rows_In_The_Workbook_In_The_Sheet(book As Workbook, sheetName As String, startRow As Long)
'To speed up the program. Tell Excel to not update formulas until finished
Application.Calculation = xlCalculationManual
'Turn off "window jumping"
'Application.ScreenUpdating = False
With book.Sheets(sheetName)
'This not the last used row in the entire sheets used range.
'Just the last used row number in Column A,
'since that's where we are going to be reading the shifting "instructions" from.
Dim lastUsedRowNumber As Long
lastUsedRowNumber = .Range("A" & .Rows.Count).End(xlUp).Row
Dim currentEndColumnNumber As Integer
Dim currentStartColumnLetter_Input As String
Dim currentStartColumnLetter As String
Dim currentStartColumnNumber As Variant
Dim amountToShift_Input As String
Dim amountToShift As Integer
Dim currentBlockLengthToShift As Integer
Dim currentBlockStartingLocation As Range
Dim currentBlockDestination As Range
Dim currentBlockToDeleteValuesAfterTheMove As Range
Dim cell As Range
For Each cell In .Range("A" & startRow & ":" & "A" & lastUsedRowNumber)
currentStartColumnLetter_Input = Trim(cell.Value) 'We are looping through column A. So this is supposedly a potential column letter(s)
amountToShift_Input = Trim(cell.Offset(0, 1).Value) 'This is the potential number in Column B.
'If either column A, column B, or both don't have row offset "instructions", or Column A's value is more than three letters, skip row.
If (Len(currentStartColumnLetter_Input) = 0) Or (Len(amountToShift_Input) = 0) Or (amountToShift_Input = "0") Or (Len(currentStartColumnLetter_Input) > 3) Then GoTo Next_Row
'If the content in Column A is not entirely English letters (not case-sensitive: "Ab","ab","AB" are all acceptable),
'OR the content in Column B is not entirely numerical digits, skip row. (This doesn't handle the potential input "00".)
If (Is_Just_One_Or_More_English_Letters(currentStartColumnLetter_Input) = False) Or (IsNumeric(amountToShift_Input) = False) Then GoTo Next_Row
'Convert the inputs to usable values.
amountToShift = CInt(amountToShift_Input)
currentStartColumnLetter = currentStartColumnLetter_Input
'Calculate the left and right bounds for the current row.
currentStartColumnNumber = Columns(currentStartColumnLetter).Column
currentEndColumnNumber = .Cells(cell.Row, 16384).End(xlToLeft).Column ' (*)
'Block length
currentBlockLengthToShift = currentEndColumnNumber - currentStartColumnNumber + 1
'If any part of the current row is going to be moved "off of the sheet" on the right sides, skip the row.
If currentStartColumnNumber + currentBlockLengthToShift - 1 + amountToShift > 16384 Then GoTo Next_Row
'For shifting to the left (negative integers in column B ... that is currentBlockLengthToShift
'can be negative), if the the first column to move is being instructed to move to any column to
'the left of Column C, go to the next row.
If currentStartColumnNumber + amountToShift < 3 Then GoTo Next_Row
'Starting location, ending location.
Set currentBlockStartingLocation = .Range(.Cells(cell.Row, currentStartColumnNumber), .Cells(cell.Row, currentStartColumnNumber + currentBlockLengthToShift - 1))
Set currentBlockDestination = .Range(.Cells(cell.Row, currentStartColumnNumber + amountToShift), .Cells(cell.Row, currentStartColumnNumber + currentBlockLengthToShift - 1 + amountToShift))
'Block portion to erase after move. (We are copying. We have to delete after to mimic CUTTING.)
If amountToShift > 0 Then
Set currentBlockToDeleteValuesAfterTheMove = .Range(.Cells(cell.Row, currentStartColumnNumber), .Cells(cell.Row, currentStartColumnNumber + amountToShift - 1))
Else 'amountToShift < 0 because we exited already if amountToShift = 0
Set currentBlockToDeleteValuesAfterTheMove = .Range(.Cells(cell.Row, currentStartColumnNumber + currentBlockLengthToShift - 1 + amountToShift + 1), .Cells(cell.Row, currentStartColumnNumber + currentBlockLengthToShift - 1))
End If
'Make the move.
'Copy
currentBlockDestination.Value = currentBlockStartingLocation.Value '(Line #1)
'Debug.Print currentBlockStartingLocation.Address & " moved to " & currentBlockDestination.Address
'Erase
currentBlockToDeleteValuesAfterTheMove.Value = "" '(Line #2)
'Debug.Print currentBlockToDeleteValuesAfterTheMove.Address & " erased "
'If you want to use cut and paste (to move all formatting, formulas, and values),
'comment the above to lines (Line #1 and Line #2) and uncomment the line below.
'currentBlockStartingLocation.Cut (.Cells(cell.Row, currentStartColumnNumber + amountToShift))
'For Debugging/seeing what is moved, where it is moved, and what is deleted.
'Coloring blocks that are moved (see the video)
'currentBlockStartingLocation.Interior.Color = RGB(255, 0, 0)
'currentBlockDestination.Interior.Color = RGB(0, 0, 255)
'currentBlockToDeleteValuesAfterTheMove.Interior.Color = RGB(255, 255, 0)
'Alternatively (instead of coloring the blocks), see this for the first row it shifts).
'currentBlockStartingLocation.Select
'MsgBox ""
'currentBlockDestination.Select
'MsgBox ""
'currentBlockToDeleteValuesAfterTheMove.Select
'MsgBox ""
'End
'GoTo Next_Row2 '(Uncomment this line if you want to uncomment the Debug.print below!)
Next_Row:
'Debug.Print "Row " & cell.Row & " skipped."
Next_Row2:
Next cell
End With
'Turn the two things we turned off back on.
Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
End Sub
Sub Test__Is_Just_One_Or_More_English_Letters()
MsgBox Is_Just_One_Or_More_English_Letters("AC")
End Sub
'A regular expression, https://stackoverflow.com/questions/29633517/how-can-i-check-if-a-string-only-contains-letters
Function Is_Just_One_Or_More_English_Letters(strValue As String) As Boolean
Is_Just_One_Or_More_English_Letters = strValue Like WorksheetFunction.Rept("[a-zA-Z]", Len(strValue))
End Function
