# Amount put in one cell automatically populates other cells on same row

Excel 2007.

I need an automatic function so that when I put in a dollar amount in Col F it does the following:

- Puts today's date in Col G and Col K (4/6/11 format)
- Also put 'EP' in Col G before the date
- Use a formula in Col i (=IF(F42*1.85%<25,F42-30,F42-(F42*1.85%)-5))  to take out 1.85% and also subtract \$5 and then
- in Col L insert the difference between Col F and Col i

Attached is an example of what I do manually that I would like to be automatic. Also, please note that there is an automatic code going on already that splits the amounts into \$2000 increments and establishes a date, in case you needed to know. That code is kicked off when a value is put into Col i

Asked:
###### Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Commented:
Ok, these are the formulas to every column

For column G
=IF(NOT(ISBLANK(F5)),"EP -" & TEXT(TODAY(),"mm/dd"),"")

For column K
=IF(NOT(ISBLANK(F5)),TODAY(),"")
You have to set format in Date for this column

For column i you alredy have the formula

For coulmn L
=F5-I5

Note
You have to set correct format for every column, but this work.

0
Commented:
Try macro below:-

``````Private Sub Worksheet_Change(ByVal Target As Range)

Dim num, count, dateAdder As Integer
Dim startDate As Date
Dim colnum, rowNum, stopRow As Integer

'Insert start here -----------
If Not Intersect(Target, Range("F:F")) Is Nothing Then
Target.Select
If Target.Offset(1, 5).Value = "" Then
Application.ScreenUpdating = False
ActiveCell.Offset(, 1).Value = "EP-" & Month(Now()) & "/" & Year(Now())
ActiveCell.Offset(, 3).Formula = "=IF(F" & Target.Row & "*1.85%<25,F" & Target.Row & _
"-25,F" & Target.Row & "-(F" & Target.Row & "*1.85%)-5)"
ActiveCell.Offset(, 7).Value = ActiveCell.Value - ActiveCell.Offset(, 3).Value
Application.ScreenUpdating = True
End If
End If
'End of insert --------------

If Not Intersect(Target, Range("col2k")) Is Nothing Then
dateAdder = 1
colnum = Range("col2k").Column
'startDate = WorksheetFunction.Max(Columns(colnum + 2))
startDate = Left(Now(), 10) 'Changed start date
If Date - 1 > startDate Then
startDate = Date - 1
End If.
.
.
``````
0
Commented:
Amended
``````Private Sub Worksheet_Change(ByVal Target As Range)

Dim num, count, dateAdder As Integer
Dim startDate As Date
Dim colnum, rowNum, stopRow As Integer

'Insert start here -----------
If Not Intersect(Target, Range("F:F")) Is Nothing Then
Target.Select
If Target.Offset(1, 5).Value = "" Then
Application.ScreenUpdating = False
ActiveCell.Offset(, 1).Value = "EP-" & Month(Now()) & "/" & Year(Now())
ActiveCell.Offset(, 3).Formula = "=IF(F" & Target.Row & "*1.85%<25,F" & Target.Row & _
"-25,F" & Target.Row & "-(F" & Target.Row & "*1.85%)-5)"
ActiveCell.Offset(, 5).Value = Date
ActiveCell.Offset(, 6).Formula = "=F" & Target.Row & "-I" & Target.Row
Application.ScreenUpdating = True
End If
End If
'End of insert --------------

If Not Intersect(Target, Range("col2k")) Is Nothing Then
dateAdder = 1
colnum = Range("col2k").Column
'startDate = WorksheetFunction.Max(Columns(colnum + 2))
startDate = Date 'Changed start date
If Date - 1 > startDate Then
startDate = Date - 1
End If.
.
.
``````
0
Author Commented:
chwong67,

I have over 100 sheets in my workbook. About 90 of them need this function. How do I have it be activated for all the sheets in the workbook?
0
Author Commented:
Never mind. I figured that out, I think. I'll try your code and see if it works. Thank you.
0
Author Commented:
No, on second thought, I only know how to make the code activate by a button or by inserting it into the Quick Access bar. What I need is for it to automatically work on inserting a value into Col i on only the pages I designate. In other words, if the sheet (tab label)  has an 'OS' or a 'MC' at the beginning of the label, I don't want the code to run. But I do want to run automatically on every other page in the workbook.

I know I forgot to add this in the description. Sorry.
0
Commented:
Try macro below to Module1...
Assumptions:
1. Respective sheet do not have WorkSheet_Change macro...
2. Do not change existing records that has been processed ...
``````Sub AdjustAmt()
For Each ws In ActiveWorkbook.Sheets
If UCase(Left(Trim(ws.Name), 2)) <> "OS" And _
UCase(Left(Trim(ws.Name), 2)) <> "MC" And _
UCase(Trim(ws.Name)) <> "SUMMARY" Then
With Sheets(ws.Name)
i = 2
Do Until i > .UsedRange.Rows.count
If .Cells(i, 6).Value <> "" Then
If .Cells(i, 9).Value = "" Then 'Do bot Overwrite Existing Record
Application.ScreenUpdating = False
.Cells(i, 7).Value = "EP-" & Month(Date) & "/" & Year(Date)
.Cells(i, 9).Formula = "=IF(F" & i & "*1.85%<25,F" & i & _
"-25,F" & i & "-(F" & i & "*1.85%)-5)"
.Cells(i, 11).Value = Date
.Cells(i, 12).Formula = "=F" & i & "-I" & i
Rows_Change (i)
Application.ScreenUpdating = True
End If
End If
i = i + 1
Loop
End With
End If
Next ws

End Sub

Private Sub Rows_Change(ByRef mrow As Long)

Dim num, count, dateAdder As Integer
Dim startDate As Date
Dim colnum, rowNum, stopRow As Integer

dateAdder = 1
colnum = Range("col2k").Column
'startDate = WorksheetFunction.Max(Columns(colnum + 2))
startDate = Date
If Date - 1 > startDate Then
startDate = Date - 1
End If

'rowNum = Target.Row
rowNum = mrow
stopRow = mrow + 1
Do While rowNum < stopRow
count = 1
If Weekday(startDate + dateAdder) = 7 Then 'Saturday
dateAdder = dateAdder + 2
End If
If Weekday(startDate + dateAdder) = 1 Then 'Sunday
dateAdder = dateAdder + 1
End If

If Cells(rowNum, colnum).Value > 0 Then
num = Cells(rowNum, colnum).Value
Do While num > 2000
Application.EnableEvents = False
Cells(rowNum + count, colnum).EntireRow.Insert
Application.EnableEvents = True
stopRow = stopRow + 1
Cells(rowNum + count, colnum + 1).Value = 2000
Cells(rowNum + count, colnum + 2).Value = startDate + dateAdder
num = num - 2000
count = count + 1
dateAdder = dateAdder + 1
If Weekday(startDate + dateAdder) = 7 Then 'Saturday
dateAdder = dateAdder + 2
End If
If Weekday(startDate + dateAdder) = 1 Then 'Sunday
dateAdder = dateAdder + 1
End If
Loop
Application.EnableEvents = False
Cells(rowNum + count, colnum).EntireRow.Insert
Application.EnableEvents = True
stopRow = stopRow + 1
Cells(rowNum + count, colnum + 1).Value = num
Cells(rowNum + count, colnum + 2).Value = startDate + dateAdder
End If
rowNum = rowNum + 1
Loop

End Sub
``````
0
Author Commented:
Ok, thank you, chwong67, but a few questions I still have.

1. Will this code kick in and work once I put a value in Col i? (In other words, automatic without having to click a button?)
2. How do I insert this code so that it will be activated across all sheets except for the OS and MC pages?
0
Commented:
1. If you do not have WorkSheet_Change macro, there will be no changes for the code. If you have this macro, this macro will be
triggered when there is changes in Col i and will overwrite Rows_Change macro.
2. You can insert the macro code in Module1 and run macro once for AdjustAmt for all sheets except  for the OS and MC pages.
Please note the assumptions.
0
Commented:
JaseS:

Since you have 90 sheets, writing a WorkSheet_Change for each doesn't make any sense nor does pasting the code in a module and calling it from there.

Do this. In the workbook code area, paste this code. (See snap shot).

``````Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If UCase(Left(Trim(Sh.Name), 2)) <> "OS" And _
UCase(Left(Trim(Sh.Name), 2)) <> "MC" And _
UCase(Trim(Sh.Name)) <> "SUMMARY" Then

'~~> Your code here

End If
End Sub
``````

Sid

Untitled.jpg
0
Author Commented:
Hi Sid,

I put chwong67's code in as suggested (please see snap shot) and inserted a value into col i and nothing happens. HOWEVER (sorry) I realized that I need this code to kick off when inserting a value in Col F, NOT i. That is what I initially stated at the opening of this question, but misstated it in later posts. My apologies..
0
Commented:
Please upload your latest file

Sid
0
Author Commented:
Uploaded one page.

If you drag (copy down) the last amount in Col i to the row where 8,188.94 is (row 20), you will see J, K and L populate. Now, what I'm wanting to happen is that when an amount is input into Col F, it does as the question originally stated, which is:

- Puts today's date in Col G and Col K (4/6/11 format)
- Also put 'EP' in Col G before the date
- Use a formula in Col i (=IF(F42*1.85%<25,F42-30,F42-(F42*1.85%)-5)) so that it takes out 1.85% and also subtract \$5 and then
- in Col L insert the difference between Col F and Col i

Book3.xls
0
Commented:
Ok I have deleted all the code from the Sheet "Antony Fort (2)" and from the workbook.

Please ensure you don't have Workbook_SheetChange events for any individual sheets.

I have also amend added the main code to the Workbook Code Area. Now when you make a change in Col F, you will see the relevant change happening :)

Sid

Code Used

``````Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Set ws = ActiveSheet
If UCase(Left(Trim(ws.Name), 2)) <> "OS" And _
UCase(Left(Trim(ws.Name), 2)) <> "MC" And _
UCase(Trim(ws.Name)) <> "SUMMARY" Then
If Not Intersect(Target, Columns(6)) Is Nothing Then
With Sheets(ws.Name)
i = Target.row
If IsNumeric(.Cells(i, 6).Value) Then
Application.ScreenUpdating = False
.Range("G" & i).Value = "EP " & Format(Date, "mm/dd/yy")
.Range("K" & i).Value = Date
.Range("K" & i).NumberFormat = "mm/dd/yy"
'=IF(F42*1.85%<25,F42-30,F42-(F42*1.85%)-5)
.Range("I" & i).Formula = "=IF(F" & i & "*1.85%<25,F" & i & _
"-25,F" & i & "-(F" & i & "*1.85%)-5)"
.Range("L" & i).Formula = "=F" & i & "-I" & i
Application.ScreenUpdating = True
End If
End With
End If
End If
End Sub
``````
Sample.xls
0
Author Commented:
Ok, I see a problem

Yes, your code works however, I need to have the other code kickoff when a value is put into Col i. What I did before was pull down-copy from the previous entry in col i which then would kick off the code of parsing out the amounts and dates. Now, although I don't really need to pull down to get the amount into col i, if I do or don't, the amounts and dates are not parsed as I need them to be.
0
Commented:
>>>I need to have the other code kickoff when a value is put into Col i.

Sorry, i lost you there...

Sid

0
Author Commented:
well, when you drag, copy down, from Col i, row 14 to row 20 you will see - in the original file I sent you - code initiate the parsing of amounts and dates.
0
Commented:
Ok Try this

Sample Attached.

Sid

Code Used

``````Dim num, count, dateAdder As Integer
Dim startDate As Date
Dim colnum, rowNum, stopRow As Integer

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Set ws = ActiveSheet
If UCase(Left(Trim(ws.Name), 2)) <> "OS" And _
UCase(Left(Trim(ws.Name), 2)) <> "MC" And _
UCase(Trim(ws.Name)) <> "SUMMARY" Then
If Not Intersect(Target, Columns(6)) Is Nothing Then
With Sheets(ws.Name)
i = Target.row
If IsNumeric(.Cells(i, 6).Value) Then
Application.ScreenUpdating = False
.Range("G" & i).Value = "EP " & Format(Date, "mm/dd/yy")
.Range("K" & i).Value = Date
.Range("K" & i).NumberFormat = "mm/dd/yy"
.Range("I" & i).Formula = "=IF(F" & i & "*1.85%<25,F" & i & _
"-25,F" & i & "-(F" & i & "*1.85%)-5)"
.Range("L" & i).Formula = "=F" & i & "-I" & i
Application.ScreenUpdating = True
End If
End With
ElseIf Not Intersect(Target, Columns(9)) Is Nothing Then
MsgBox "a"
Application.EnableEvents = False
dateAdder = 1: colnum = 9
startDate = WorksheetFunction.Max(Columns(colnum + 2))
If Date - 1 > startDate Then
startDate = Date - 1
End If

rowNum = Target.row
stopRow = Target.row + Target.Rows.count
Do While rowNum < stopRow
count = 1
If Weekday(startDate + dateAdder) = 7 Then 'Saturday
dateAdder = dateAdder + 2
End If
If Weekday(startDate + dateAdder) = 1 Then 'Sunday
dateAdder = dateAdder + 1
End If

If Cells(rowNum, colnum).Value > 0 Then
num = Cells(rowNum, colnum).Value
Do While num > 2000

Cells(rowNum + count, colnum).EntireRow.Insert
stopRow = stopRow + 1
Cells(rowNum + count, colnum + 1).Value = 2000
Cells(rowNum + count, colnum + 2).Value = startDate + dateAdder
num = num - 2000
count = count + 1
dateAdder = dateAdder + 1
If Weekday(startDate + dateAdder) = 7 Then 'Saturday
dateAdder = dateAdder + 2
End If
If Weekday(startDate + dateAdder) = 1 Then 'Sunday
dateAdder = dateAdder + 1
End If
Loop
Cells(rowNum + count, colnum).EntireRow.Insert

stopRow = stopRow + 1
Cells(rowNum + count, colnum + 1).Value = num
Cells(rowNum + count, colnum + 2).Value = startDate + dateAdder
End If
rowNum = rowNum + 1
Loop
End If
Application.EnableEvents = True
End If
End Sub
``````
Book3.xls
0
Author Commented:
Works great! Except....

There's a little dialog box that comes up (I'm sure you were using that for testing)
AND
more problematic is that when I delete the value from Col G, it runs the code anyway:

EP 04/07/11            -\$25.00            04/07/11      25.00

And can you put a space - space between EP and the date in col G to separate the two?

But thanks! It works like a charm. A tad slow, but no big deal.
0
Commented:
Oops, I missed that MSGBOX :)

Try this code

``````Dim num, count, dateAdder As Integer
Dim startDate As Date
Dim colnum, rowNum, stopRow As Integer

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo err
Set ws = ActiveSheet
If UCase(Left(Trim(ws.Name), 2)) <> "OS" And _
UCase(Left(Trim(ws.Name), 2)) <> "MC" And _
UCase(Trim(ws.Name)) <> "SUMMARY" Then
If Not Intersect(Target, Columns(6)) Is Nothing And Len(Trim(Target.Value)) <> 0 Then
MsgBox "b"
With Sheets(ws.Name)
i = Target.row
If IsNumeric(.Cells(i, 6).Value) Then
Application.ScreenUpdating = False
.Range("G" & i).Value = "EP " & Format(Date, "mm/dd/yy")
.Range("K" & i).Value = Date
.Range("K" & i).NumberFormat = "mm/dd/yy"
.Range("I" & i).Formula = "=IF(F" & i & "*1.85%<25,F" & i & _
"-25,F" & i & "-(F" & i & "*1.85%)-5)"
.Range("L" & i).Formula = "=F" & i & "-I" & i
Application.ScreenUpdating = True
End If
End With
ElseIf Not Intersect(Target, Columns(9)) Is Nothing Then
MsgBox "a"

dateAdder = 1: colnum = 9
startDate = WorksheetFunction.Max(Columns(colnum + 2))
If Date - 1 > startDate Then
startDate = Date - 1
End If

rowNum = Target.row
stopRow = Target.row + Target.Rows.count
Do While rowNum < stopRow
count = 1
If Weekday(startDate + dateAdder) = 7 Then 'Saturday
dateAdder = dateAdder + 2
End If
If Weekday(startDate + dateAdder) = 1 Then 'Sunday
dateAdder = dateAdder + 1
End If

If Cells(rowNum, colnum).Value > 0 Then
num = Cells(rowNum, colnum).Value
Do While num > 2000

Cells(rowNum + count, colnum).EntireRow.Insert
stopRow = stopRow + 1
Cells(rowNum + count, colnum + 1).Value = 2000
Cells(rowNum + count, colnum + 2).Value = startDate + dateAdder
num = num - 2000
count = count + 1
dateAdder = dateAdder + 1
If Weekday(startDate + dateAdder) = 7 Then 'Saturday
dateAdder = dateAdder + 2
End If
If Weekday(startDate + dateAdder) = 1 Then 'Sunday
dateAdder = dateAdder + 1
End If
Loop
Cells(rowNum + count, colnum).EntireRow.Insert

stopRow = stopRow + 1
Cells(rowNum + count, colnum + 1).Value = num
Cells(rowNum + count, colnum + 2).Value = startDate + dateAdder
End If
rowNum = rowNum + 1
Loop
End If
Application.EnableEvents = True
End If
Exit Sub
err:
If err.Number <> 13 Then MsgBox err.Description
Application.EnableEvents = True
End Sub
``````

Sid
0
Commented:
Wait.

Sid
0
Commented:
Try this

``````Dim num, count, dateAdder As Integer
Dim startDate As Date
Dim colnum, rowNum, stopRow As Integer

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo err
Set ws = ActiveSheet
If UCase(Left(Trim(ws.Name), 2)) <> "OS" And _
UCase(Left(Trim(ws.Name), 2)) <> "MC" And _
UCase(Trim(ws.Name)) <> "SUMMARY" Then
If Not Intersect(Target, Columns(6)) Is Nothing And Len(Trim(Target.Value)) <> 0 Then
With Sheets(ws.Name)
i = Target.row
If IsNumeric(.Cells(i, 6).Value) Then
Application.ScreenUpdating = False
.Range("G" & i).Value = "EP " & Format(Date, "mm/dd/yy")
.Range("K" & i).Value = Date
.Range("K" & i).NumberFormat = "mm/dd/yy"
.Range("I" & i).Formula = "=IF(F" & i & "*1.85%<25,F" & i & _
"-25,F" & i & "-(F" & i & "*1.85%)-5)"
.Range("L" & i).Formula = "=F" & i & "-I" & i
Application.ScreenUpdating = True
End If
End With
ElseIf Not Intersect(Target, Columns(9)) Is Nothing Then
dateAdder = 1: colnum = 9
startDate = WorksheetFunction.Max(Columns(colnum + 2))
If Date - 1 > startDate Then
startDate = Date - 1
End If

rowNum = Target.row
stopRow = Target.row + Target.Rows.count
Do While rowNum < stopRow
count = 1
If Weekday(startDate + dateAdder) = 7 Then 'Saturday
dateAdder = dateAdder + 2
End If
If Weekday(startDate + dateAdder) = 1 Then 'Sunday
dateAdder = dateAdder + 1
End If

If Cells(rowNum, colnum).Value > 0 Then
num = Cells(rowNum, colnum).Value
Do While num > 2000

Cells(rowNum + count, colnum).EntireRow.Insert
stopRow = stopRow + 1
Cells(rowNum + count, colnum + 1).Value = 2000
Cells(rowNum + count, colnum + 2).Value = startDate + dateAdder
num = num - 2000
count = count + 1
dateAdder = dateAdder + 1
If Weekday(startDate + dateAdder) = 7 Then 'Saturday
dateAdder = dateAdder + 2
End If
If Weekday(startDate + dateAdder) = 1 Then 'Sunday
dateAdder = dateAdder + 1
End If
Loop
Cells(rowNum + count, colnum).EntireRow.Insert

stopRow = stopRow + 1
Cells(rowNum + count, colnum + 1).Value = num
Cells(rowNum + count, colnum + 2).Value = startDate + dateAdder
End If
rowNum = rowNum + 1
Loop
End If
Application.EnableEvents = True
End If
Exit Sub
err:
If err.Number <> 13 Then MsgBox err.Description
Application.EnableEvents = True
End Sub
``````

Sid
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Author Commented:
can you send me the spreadsheet. Not sure why, but nothing happens.
0
Commented:
Here it is.

Sid
Book3.xls
0
Author Commented:
nope, nothing hapens when I put a value in Col F
0
Commented:
Ok Do this

Paste this in a module and run it. And then Try putting a value in F

``````Sub Sample
Application.EnableEvents = True
End Sub
``````

Sid
0
Author Commented:
Nothing. It is attached.
I have to be out for about 1 1/2 hours. I'll check back then.

Thanks. Book3-B.xls
0
Commented:
Strange. it works for me. I deleted the values and colored the cells yellow. Now when I change the value of F2, you will see the changes. Same is with F6.

Please see screencast

Sid
SiddharthRout-441885.flv
0
Author Commented:
okay, your code works, thank you,  but...

I was hoping that when it populated Col i it would kick off the code to parse out the amounts you see in col J and col K as happens when I pull (copy-down) from Col K.

Can you make it do that? Does that part require another related project question?
0
Commented:
That would be another question :)

Also I might not be able to answer that till Tuesday. Any moment, I will be off(Shifting to a new house)

Sid
0
Author Commented:
okay, count it as another question then. I will post it soon, with minimum description, as you know what I am needing. Thank you for your help. Happy moving! Where do you live, btw?
0
Commented:
Mumbai, India :)

Sid
0
Author Commented:
Professional, quick and great work every step of the way!
0
Author Commented:
0
Author Commented:
Sid, I am having problems with this code. Problem is that I often have to exit Excel then restart it before your code will do it's thing. Can this be fixed? It's really great when it works, but it is rather a hassle to close Excel and restart it so that it will. And... even after I restart Excel, it might work for one or a few times before it stops. I hope you can get to it, soon.
0
Author Commented:
Sid, I hope you can get to this and the other project outstanding real soon. I am needing both of them completed. If you want, I can reassign this project to another question, no problem so you can trouble shoot it. But I also need the other project done asap, like within a day if at all possible.
0
Author Commented:
Calling Sid! Are you there?
0
Author Commented:
Now my original code is not even working. HELP!!!
0
Commented:
What exactly is not working?

Is enableevents on? see ID: 35345847 on top.

Sid
0
###### It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.