It is amazing that excel does not have a way to automatically copy a formula to the right. I have written some code in generic macros that allows you to efficiently copy to the right (SHIFT, CNTL, R). I have tried to make the copy to the right macro flexible meaning that you can define parameters differntly. So, if you have the generic macro sheet open, and if you have a row of numbers somewhere, you can press SHIFT, CNTL, R and the numbers will copy to the right for as long as your row of numbers. Some people have asked me if there is a way to put the Shift, CNTL, R code into your file so that generic macros does not have to be open. The file below has that allows you to do this. All you have to do is to copy the code from the macro to your macro and include the “on key” code. The file is attached to the button below. The full code is listed at the bottom of this page.
How to Use Generic Macros to Copy to the Right
To see this, go to a blank sheet and press the number one somewhere near the top (for example in cell D4. Then press either ALT, E, I, S or ALT, or ALT, H, FI, S. (In French it is a bit more complicated). You will get a little menu like the following:
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)
I have also tried to add an undo option to the Shift, CNLT, R macro which you can access with SHIFT, CNLT, S. Test the SHIFT,CNTL,S you can enter some other formula in the third row that currently contains 300. Then press SHIFT,CNTL,S. You should get the original number back.
You can also adjust the SHIFT, CNTL, R to look up to different rows and test other things. To adjust the generic macro file, you go to the first sheet of the file and change the parameters. After you change the parameters however you must run the implement macros macro.
If you want to put the SHIFT,CNTL, R macro in your workbook or in your personal workbook, I suggest copying the entire module where the macro is located in the generic macros.
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