Copy to the Right (SHIFT,CNTL,R)

 

 

Then press the number 9 as the stop value and you will have a row of numbers.  Just below the row of numbers (i.e. below the number 1), enter a few more numbers.  I put in 100, 200 and then used the ALT, = short cut to add the numbers together as shown on the screenshot below.

 

 

Next, select the three numbers (the 100, 200 and 300) and press SHIFT, CNTL, R.  The numbers should copy to the right as shown in the screenshot below.  If this is not working, then you probably either do not have generic macros.xls open or the file is not enabled.

 

 

Undo Option with Copying to the Right (SHIFT, CNTL, S)

 

Videos that Illustrate use of Generic Macros File

The first video below demonstrates how to use the Generic Macros file that you must download to colour your sheet efficiently.

 

 

Code for Copying the SHIFT, CNTL, R macro into your file

Note that when you are copying this code that you may not want to use the auto_open if there are some kind of restrictions on its use.  You can then just re-name the auto open function.

Option Base 1
Public calculation_state As Single

Public max_row As Single ' for finding number of rows in sheet
Public max_col As Single ' for finding number of cols in sheet

Public end_row As Single ' end row in shift cntl R
Public end_row_scan As Single ' maximum number of rows to scan

Public scan_cols As Single ' number of colums to scan in finding rows
Public end_col As Single ' end col in shift cntl R
Public end_col_scan As Single ' number of columns to scan
Public scan_rows As Single ' number of rows to scan in finding columns

Public max_test_row As Single
Public shortest_col_for_test As Single
Public look_in_up_rows As Boolean

Public data_to_save(10000) As Variant ' for undoing the shift CNTL R
Public end_col_range As Single
Public row_to_save As Single
Public col_to_save As Single

Public col_start As Single
Public col_end As Single
Public row_selected As Single

Public initial_end_row_scan As Single

'
' Copy the public variables above
'


Public Sub Auto_Open()
'
'
' When set to mannual will not recalculate on save
'
Application.CalculateBeforeSave = False
Application.ScreenUpdating = False
Sheets(1).Select
calculation_state = Application.Calculation
Application.Calculation = xlCalculationManual

generic_macro_file = ActiveWorkbook.Name

'
'---------------------------------------------------------------------------------------------------------------------------------
'
' Assign Short-cut keys ^ is CNTL, % is ALT, + is Shift
' Shift is very dangerous because you may change the keyboard
' Alt does not work with things like Alt D and Alt E because these are reserved
'

Application.OnKey "^R", "x_fill_right"
Application.OnKey "^S", "x_undo_fill_right"

' These are defaults from range names in the first sheet of generic macros
' parameters for shift cntl R
'
max_test_row = 20
shortest_col_for_test = 5
look_in_up_rows = False


End Sub


' This is a key program that defines max_row that is used in many other programs with a public variable

Sub x_find_rows() ' The find rows is used in the colour macro a lot and in other macros that go around rows
' defines the max_row with is a public variable
start_row = 1
start_col = 1
max_row = 0 ' max row is a public variable that used elsewhere
same_row = 0
Start = 1

If end_row_scan = 0 Then
end_row_scan = 450

MsgBox " Must Initialise Generic Macros for Row and Column Definition "

end_row_scan = initial_end_row_scan

' End ' Unless end the system crashes
End If

For row = Start To end_row_scan ' the end row is a maximum row defined to make the process not to slow
' end row is a public variable
For col = start_col To scan_cols ' colums to test whether there is anything in row; allowance for blank columns on left

last_max = max_row

' If row Mod 10 = 0 Then ' only display every 10 rows - not used in program
' MsgBox " col " & col & " row " & row & " max_row " & max_row & " start row " & start_row
' End If

' this is the major test -- look for text or numbers

On Error Resume Next
If WorksheetFunction.IsText(Cells(row, col)) = True Or WorksheetFunction.IsNumber(Cells(row, col)) = True Then
If row > max_row Then max_row = row ' see if row of text > earlier max
End If

Next col ' end of scan around cols

Next row

Start = max_row ' use max row from test

' If max_row > 0 Then max_row = max_row + 15 ' add some rows

If max_row = last_max Then same_row = same_row + 1
If same_row > 10 Then

Exit Sub
End If

End Sub

' This is similar to the find rows routine -- it makes the programs work much faster and finds the columns used in a sheet

Sub x_find_cols()

start_row = 1
start_col = 1
max_col = 0
same_col = 0

If end_col_scan = 0 Then
end_col_scan = 450
MsgBox " Must Initialise Generic Macros to find Column Dimension "
' End
End If

For col = start_col To end_col_scan

For row = start_row To scan_rows ' scan rows is public variable

last_col = max_col

' If col Mod 10 = 0 Then
' MsgBox " col " & col & " row " & row & " max_row " & max_col & " start col " & start_col
' End If

On Error Resume Next ' find and re-set the maximum column
If WorksheetFunction.IsText(Cells(row, col)) = True Or WorksheetFunction.IsNumber(Cells(row, col)) = True Then
If col > max_col Then max_col = col
End If
Next row
Next col

start_col = max_col

End Sub
'||||||||||||||||||||||| These are macros for the colouring sheet |||||||||||||||||||||||||

Sub x_select_area() ' Finding the number of rows and or columsn is key for a lot of other macros

' This runs both rows and columns to test what is going on; it is not used


x_find_rows
x_find_cols

Range(Cells(1, 1), Cells(max_row, max_col)).Select


End Sub


'
' This is the SHIFT, CNTL, R function
'
' You could copy this into your personal workbook if you want and use the application.onkey
'

Sub x_fill_right()

calculation_state = Application.Calculation
Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

If show_status_bar Then _
Application.StatusBar = "SHIFT,CNTL,M to Clear Status Bar; SHIFT,CNTL Z --> First Sheet; SHIFT,CNTL,R --> Copy to Right; SHIFT,CNTL,S --> Undo Copy to Right; SHIFT,CNTL,C --> Colour Sheets "

' first section: define basic parameters

last_col = 16000 ' Last column definded from empty row. works with 2007 and later. Should adjust for verion

If shortest_col_for_test = 0 Then ' Test the data in public variables
shortest_col_for_test = 5 ' MsgBox " Shortest Column is Zero, Please press the implement button in generic macros "
End If

If max_test_row = 0 Then
max_test_row = 10 ' MsgBox " Max test to look up or down is zero, Please press the implement button in generic macros "
End If

row_num = Selection.Rows.Count ' the selection is the area that is hilighted. find how many rows hilighted
col = Selection.Columns.Count ' this is the same for the number of cols hilighted (not used)

cell_start = Selection.Cells(1, 1) ' this is the starting cell that will be copied

org_col = Selection.Cells(1, 1).Column ' get the column of the starting point
org_row = Selection.Cells(1, 1).row ' get the row of the starting point

up_move = 1 ' how many rows to move up... this will change if there are blank rows
max_col = 0
counter = 0

col_to_use_up = 1
end_col_down = 1

'-----------------------------------------------------------------------------------------------------------------------------
' SECTION 2: analysis for looking up to find longest col
'-----------------------------------------------------------------------------------------------------------------------------

copy_process: ' this is for checking rows below

' find the base number of columns for copying -- could be below or above

counter = counter + 1 ' count how many times looked in up col

If org_row = 1 Then ' skip the looking up if the first row
col_to_use_up = 0
GoTo move_down
End If

On Error GoTo exit1 ' doesnt work on first row

Cells(org_row, org_col).Select ' Go to the base for copying -- start with original row and go up go up by the up_move... first is 1
Selection.End(xlToRight).Select ' go to the end of the upwards row
end_col_range = ActiveCell.Column - 1 ' find the end col for the entire base row selected

test_cell = Cells(org_row, end_col_range) ' test cell is the end of the column

test_cell = WorksheetFunction.IfError(test_cell, " ")

' Go back and get the data to copy from the starting column

If end_col_range < last_col Then ' If end_col is less than last_col then there is stuff at the end

For k = 1 To end_col_range + 1 ' MsgBox " cells org_row k " & Cells(org_row, k).Formula & " k " & k & " org_row " & org_row

data_to_save(k) = Cells(org_row, k + org_col).Formula ' This is for the undo; do this before copying
row_to_save = org_row
col_to_save = org_col
Next k
End If

If end_col_range < last_col And test_cell = "" Then ' If end_col is less than last_col then there is stuff at the end
col_to_use_up = end_col_range
GoTo final_col
End If

Cells(org_row - up_move, org_col + 1).Select ' start with original row and go up go up by the up_move... first is 1
Selection.End(xlToRight).Select ' go to the end of the upwards row

end_col = ActiveCell.Column ' find the end col for the entire row selected
end_row = ActiveCell.row ' dont really need this

' check if have to go up further
' last col is the end of the sheet; does not work with excel 2003 with fewer cols

While org_row - up_move > 0 ' go around until get to top row ' MsgBox " in while - move up " & up_move
up_move = up_move + 1 ' keep going up
'
' Try to find the number of columns to copy to the right - before was simply the longest column
'
If end_col < last_col And end_col > max_col Then
max_col = end_col ' find max column
col_to_use_up = max_col

If end_row = 1 Then GoTo move_down: ' MsgBox " max col adjusted - max col " & max_col

End If

If end_col < last_col And end_col > shortest_col_for_test Then

col_to_use_up = end_col ' find max column ' MsgBox " test 1 going to final end col " & end_col
GoTo final_col
End If

'
' Limit the number of rows to look for
'
If counter > max_test_row Then
col_to_use_up = max_col ' find max column ' MsgBox " test 2 going to move down end col " & end_col & " Max test row " & max_text_row & " max col " & max_col

GoTo move_down: ' limit the rows to look up
End If

If col_to_use_up >= shortest_col_for_test Then
col_to_use_up = end_col ' find max column ' MsgBox " test 3 going to move down - end col " & end_col

' GoTo move_down: ' limit the rows to look up
End If

' MsgBox " end of copy process Max col " & max_col & " end col " & end_col & " counter " & counter

If end_row = 1 Then GoTo move_down:

GoTo copy_process ' go back, repeat the look down and find end col

Wend

' If look_in_up_rows = False Then GoTo final_col

move_down:

end_col = max_col
If end_col > last_col Then end_col = 1 ' this happens when go through loop and still have the entire sheet

down_move = 1

copy_process_down:

On Error GoTo exit1 ' doesnt work on first row
Cells(org_row + down_move, org_col).Select ' go up by the up_move

Selection.End(xlToRight).Select ' select the row

end_col_down = ActiveCell.Column ' find the end col
end_row_down = ActiveCell.row

' check if have to go down further
' last col is dend of sheet

If end_col_down > last_col Then ' if a blank row then go up and try again
down_move = down_move + 1
If down_move < max_test_row Then GoTo copy_process_down ' cannot work when get to the top
End If

If end_col < last_col And end_col < shortest_col_for_test Then
col_to_use_down = end_col ' find max column
GoTo final_col
End If


final_col:

If end_col_down > last_col Then end_col_down = 0 ' reset end col if not founc

end_col = WorksheetFunction.Max(col_to_use_up, end_col_down) ' the final end col to use

For row = org_row To org_row + row_num - 1 ' this is like CNTL R

If end_col > 14000 Then
MsgBox " Attmpting to copy MORE THAN 14,000 COLUMNS " & Chr(13) & " Run Implement Macros " & Chr(13) & "Technical data - col to use up " & col_to_use_up & " End col down " & end_col_down
Exit Sub
End If

Range(Cells(row, org_col), Cells(row, end_col)).Select ' select the appropriate area
Selection.FillRight ' Finally do the copy CNTL R

'
' This is for the undo stuff
'
Next row

col_start = org_col
col_end = end_col
row_selected = row

Cells(org_row, org_col).Activate ' go back to original cell

exit1:

Application.Calculation = calculation_state


End Sub


Sub x_undo_test()

test = Selection.Formula

' MsgBox test

test1 = Selection.Cells(1, 1).Formula

Selection.Clear

Selection.Cells(1, 1) = test1

End Sub
Sub x_undo_fill_right()

calculation_state = Application.Calculation
current_status = Application.Calculation
Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

On Error Resume Next

current_row = Selection.row

If current_row <> row_to_save Then
MsgBox " Undo only works after you have used Shift, CNTL, R TWO TIMES (There is no Data after the first time)"
Exit Sub
End If

' MsgBox " Current Row " & current_row & " Row to save " & row_to_save & " Col to Save " & col_to_save

For k = 1 To end_col_range + 1
Cells(row_to_save, col_to_save + k) = data_to_save(k)
Next k

Cells(row_to_save, col_to_save + 1).Select
Selection.Copy
Cells(row_to_save, col_to_save).Select
ActiveSheet.Paste

Application.CutCopyMode = False

Application.Calculation = calculation_state

End Sub


' The programs need to know how many rows and columns are in the sheet

'------------------------------------------------------------------------------------------------------------
' You need this for other macros
'------------------------------------------------------------------------------------------------------------

Sub x_find_rows_and_cols() ' Finding the number of rows and or columsn is key for a lot of other macros

' This runs both rows and columns to test what is going on; it is not used

x_find_rows
x_find_cols

' This shows the result -- this subroutine is not directly used

MsgBox " Rows in Sheet " & max_row & " Colums Scanned to Find Max Row " & scan_cols & " End Row for Scan " & end_row_scan
MsgBox " Cols in Sheet " & max_col & " Rows Scanned to Find Max Column " & scan_rows & " End Column for Scan " & end_col_scan

' current_file = ActiveWorkbook.Name

' MsgBox " Active Book " & current_file

' Workbooks(generic_file).Activate

' Range("max_row") = max_row

' Workbooks(current_file).Activate


' Workbooks(generic_book).Range("max_row") = max_row
' Workbooks(generic_book).Range("max_col") = max_col

' Workbooks(generic_book).Range("current_file") = current_file


End Sub