Iteration Macro

[danielseward408]

Morning Everyone,

I am not very good at this so I'm hoping someone can help me. I hav
attached a picture of the spreadsheet that i am working on. My end goa
is to have the numbers in column 'D','I' and 'N' to increment by thei
corresponding input cells in columns 'E','J' and 'O'. The spreadsheet i
a record of points awarded so it will be accessed a couple of times
week. Once the calculation has been completed I'd like the input cell
to be cleared.
An example would be 10 points awarded to FS 'C3'. i would enter 10 int
'D3', press enter then the cell would clear and 'C3' would increment b
10.

I hope you guys can help me.
Many thanks
Da

+-------------------------------------------------------------------
|Filename: Untitled.jpg
|Download: http://www.excelbanter.com/attachment.php?attachmentid=567
+-------------------------------------------------------------------

 

[benmcclave]

Good Morning,

This sub should do the trick. Just paste it to the sheet module (right click tab name and select "view code"). Any time a cell value changes on the sheet containing this code, the sub will check to see if there is more thanone cell affected (if so, the sub exits). Next it will check for numeric values in both the target cell and the destination cell (if either containsa non-numeric value, the sub exits). Finally, it will prompt the user to confirm the changes that the sub will perform (and exits unless the user chooses "Yes").

Hope this helps,

Ben
--------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rUpdate As Range
Set rUpdate = Target.Offset(0, -1)
'Uncomment error messages if you wish to include them
If Target.Count > 1 Then
'MsgBox "More than one cell was changed"
GoTo ExitHere
End If

Application.EnableEvents = False
Select Case Target.Column
Case Is = 5, 10, 15
If WorksheetFunction.IsNumber(Target.Value) = False Then
'MsgBox Target.Address & " does not contain a numeric value. Please try again."
GoTo ExitHere
End If
If WorksheetFunction.IsNumber(rUpdate.Value) = False Then
'MsgBox rUpdate.Address & " does not contain a numeric value. Please try again."
GoTo ExitHere
End If
If MsgBox("Would you like to add " & vbCr & vbCr & _
Format(Target.Value, "0.00") & vbCr & vbCr & _
" to cell " & rUpdate.Address & "?", vbYesNoCancel) = vbYes Then
rUpdate.Value = rUpdate.Value + Target.Value
Target.Value = vbNullString
Else
'MsgBox "Update cancelled."
End If
End Select
ExitHere:
Set rUpdate = Nothing
Application.EnableEvents = True
End Sub

 

[Living the Dream]

Hi Dan

IMO the best way to approach this would be to use VB...

Open your workbook
Hit ALT-F11
Select ( ThisWorkbook )
then go to:
Tools | Insert | Module

Once the module window opens, paste in this code.

........................................................

Sub reCalc_Scores()

Dim mySht As Worksheet
Dim myRng1 As Range, myRng2 As Range, myRng3 As Range
Dim c As Range

Set mySht = Sheets("Sheet1") 'change sheet name to suit
Set myRng1 = mySht.Range("D320") 'change range to suit
Set myRng2 = mySht.Range("I3:I20") 'change range to suit
Set myRng3 = mySht.Range("N3:N20") 'change range to suit

For Each c In myRng1
If c <> "" Then
With c
.Value = .Offset(0, 1).Value + .Value
.Offset(0, 1).Value = ""
End With
End If
Next c
For Each c In myRng2
If c <> "" Then
With c
.Value = .Offset(0, 1).Value + .Value
.Offset(0, 1).Value = ""
End With
End If
Next c
For Each c In myRng3
If c <> "" Then
With c
.Value = .Offset(0, 1).Value + .Value
.Offset(0, 1).Value = ""
End With
End If
Next c

End Sub

..................................................................

Please take notice of the comments at the end of the ( SET ) stage,
change the ( Sheet1 ) name to whatever is the name of your worksheet
which is on the tab at the bottom. Then change the range to however many
rows of names you have, I have use up to row 20 but you can go many rows
more so as to include any future additions.

HTH
Mick.

 

[Living the Dream]

Hey Dan

Forgot to include the bit on how to add a Macro Button.

In 2010 it would be:
Developer | Insert | Form Controls, then select the button.

Apologies, It's been so long since I have used older versions, I have
actually forgotten the steps...

anyhoo, if and when you manage to work it out and insert a button on
your sheet, right click on the button and select ( Assign Macro ), then
select reCalc_Scores.

Hey presto, your in business...

HTH
Mick.