# Macro to sum selected cells in a row and repeat for all rows in a column with values

#### KlayontKress

##### Board Regular
To all,

I'm looking for a macro that will allow the user to select multiple cells (up to 5) in a row (Lets say E10 and G10) and then add the sum of those two cells into the left most cell selected (this will usually be the first cell selected but it's possible the user will select the calues in a different order than left to right (we can standardize if we need to)).

I then need the macro to go through and repeat this for every row in a column with values use the same relative positions as the first series of values selected.

For example, from the chart below, lets say I select D4, E4,G4,M4. I want to placed the summed value of these into cell D4 (not the formula for the sum but the actual value). In this case it would be 23. I then need the macro to remember that the left most column is "D" and that the initial values selected were in relative positions of +0, 1, 3, and 9 to go through and do this same calculation for every row in column D with a value and put in the summed value. The macro would then deleted all of the columns for the values selected except for the left most one where the summed values went.

The values in column "D" would end up being:

D4=23
D6=27
D8=31
D10=35
D12=39

and columns E,G, and M in the column below would be deleted.

 A B C D E F G H I J K L M N O 1 2 group style Room 1 Room 2 Room 3 Room 4 Room 5 Room 6 Room 7 Room 8 Room 9 Room 10 3 4 base blah 10 1 2 3 4 5 6 7 8 9 5 6 level 1 blah blah 11 2 3 4 5 6 7 8 9 10 7 8 level 2 blah blah blah 12 3 4 5 6 7 8 9 10 11 9 10 level 3 blah blah blah blah 13 4 5 6 7 8 9 10 11 12 11 12 level 4 blaah 14 5 6 7 8 9 10 11 12 13

<tbody>
</tbody>

Thanks for your help,

Last edited:

### Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

#### RCBricker

##### Well-known Member
this should get you started. Only thing it does not do is delete the columns. I have a meeting so cant work on that.

Code:
``````Sub FORS()

Dim wb As Workbook
Dim ws As Worksheet
Dim lngROW As Long, lngCOL As Long
Dim cell1 As Range, cell2 As Range, cell3 As Range, cell4 As Range, cell5 As Range
Dim int1 As Integer, int2 As Integer, int3 As Integer, int4 As Integer, int5 As Integer, intST As Integer, intROW As Integer
Dim rng As Range, cell As Range
Dim dSUM As Double
Dim i As Variant

Set wb = ThisWorkbook
On Error Resume Next
Set cell1 = Application.InputBox(Prompt:="Please select a cell", Title:="cell selection", Type:=8)
On Error GoTo 0
If cell1 Is Nothing Then
MsgBox "User failed to select a cell.  Please start again"
End
End If
int1 = cell1.Column
intROW = cell1.Row
Set ws = ActiveSheet

lngCOL = ws.Cells.Find(What:="*", _
after:=ws.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column

On Error Resume Next
Set cell2 = Application.InputBox(Prompt:="Please select a cell", Title:="cell selection", Type:=8)
On Error GoTo 0
If cell2 Is Nothing Then
MsgBox "User failed to select a cell.  Please start again"
End
End If
If cell2.Row <> intROW Then
MsgBox "User selected a cell on different row.  Please start again"
End
Else
int2 = cell2.Column
End If
On Error Resume Next
Set cell3 = Application.InputBox(Prompt:="Please select a cell", Title:="cell selection", Type:=8)
On Error GoTo 0
If cell3 Is Nothing Then
MsgBox "User failed to select a cell.  Please start again"
End
End If
If cell3.Row <> intROW Then
MsgBox "User selected a cell on different row.  Please start again"
End
Else
int3 = cell3.Column
End If
On Error Resume Next
Set cell4 = Application.InputBox(Prompt:="Please select a cell", Title:="cell selection", Type:=8)
On Error GoTo 0
If cell4 Is Nothing Then
MsgBox "User failed to select a cell.  Please start again"
End
End If
If cell4.Row <> intROW Then
MsgBox "User selected a cell on different row.  Please start again"
End
Else
int4 = cell4.Column
End If
On Error Resume Next
Set cell5 = Application.InputBox(Prompt:="Please select a cell", Title:="cell selection", Type:=8)
On Error GoTo 0
If cell5 Is Nothing Then
MsgBox "User failed to select a cell.  Please start again"
End
End If
If cell5.Row <> intROW Then
MsgBox "User selected a cell on different row.  Please start again"
End
Else
int5 = cell5.Column
End If

intST = WorksheetFunction.Min(int1, int2, int3, int4, int5)

dSUM = cell1 + cell2 + cell3 + cell4 + cell5
ws.Cells(intROW, intST).Value = dSUM

End Sub``````

Replies
1
Views
128
Replies
3
Views
63
Replies
5
Views
271
Replies
9
Views
217
Replies
2
Views
92

1,129,557
Messages
5,637,043
Members
416,955
Latest member
Gohar hussain

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

### Which adblocker are you using?

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

### Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back