JaseS
asked on
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,F
- 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
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,F
- 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
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.
.
.
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.
.
.ASKER
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?
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?
ASKER
Never mind. I figured that out, I think. I'll try your code and see if it works. Thank you.
ASKER
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.
I know I forgot to add this in the description. Sorry.
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 ...
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 SubASKER
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?
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?
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.
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.
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).
Sid
Untitled.jpg
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 SubSid
Untitled.jpg
ASKER
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..
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..
Please upload your latest file
Sid
Sid
ASKER
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,F
- in Col L insert the difference between Col F and Col i
Book3.xls
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,F
- in Col L insert the difference between Col F and Col i
Book3.xls
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
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 SubASKER
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.
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.
>>>I need to have the other code kickoff when a value is put into Col i.
Sorry, i lost you there...
Sid
Sorry, i lost you there...
Sid
ASKER
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.
Ok Try this
Sample Attached.
Sid
Code Used
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 SubASKER
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.
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.
Oops, I missed that MSGBOX :)
Try this code
Sid
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 SubSid
Wait.
Sid
Sid
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
can you send me the spreadsheet. Not sure why, but nothing happens.
ASKER
nope, nothing hapens when I put a value in Col F
Ok Do this
Paste this in a module and run it. And then Try putting a value in F
Sid
Paste this in a module and run it. And then Try putting a value in F
Sub Sample
Application.EnableEvents = True
End SubSid
ASKER
Nothing. It is attached.
I have to be out for about 1 1/2 hours. I'll check back then.
Thanks. Book3-B.xls
I have to be out for about 1 1/2 hours. I'll check back then.
Thanks. Book3-B.xls
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
Please see screencast
Sid
SiddharthRout-441885.flv
ASKER
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?
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?
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
Also I might not be able to answer that till Tuesday. Any moment, I will be off(Shifting to a new house)
Sid
ASKER
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?
Mumbai, India :)
Sid
Sid
ASKER
Professional, quick and great work every step of the way!
ASKER
Related question now being posted. Link here:
https://www.experts-exchange.com/questions/26946560/Continuing-from-previous-question-one-code-kicking-off-another.html
https://www.experts-exchange.com/questions/26946560/Continuing-from-previous-question-one-code-kicking-off-another.html
ASKER
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.
ASKER
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.
ASKER
Calling Sid! Are you there?
ASKER
Now my original code is not even working. HELP!!!
What exactly is not working?
Is enableevents on? see ID: 35345847 on top.
Sid
Is enableevents on? see ID: 35345847 on top.
Sid
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.