• Status: Solved
• Priority: Medium
• Security: Public
• Views: 193

Parsing amounts to dates

Using the same spreadsheet from the previous, related question, I need the following done on the Goga Tora sheet.

-When an amount is input into column D, it needs to divide that amount into portions that do not exceed 2,000 per day and what is remaining after 2,000 gets parsed out as amounts in cols G, K, O, etc (as seen on the sheet) until there is none remaining.

If you look at the sheet you will see that the last entry in col D is 6470.06. That is over 2,000 so I have to divide it into 2,000 increments for three days until on the final day there is only 470.06 left. And as you can see, those amounts are put in each of the columns: G, K, O, S, W, AA and AE.

When these amounts are parsed out, there also has to be created a date and the date cannot include weekends.

Please refer to the original document I posted and ask if any questions.
I'd like this code to be run also by a button clicked on the Goga Tora page.
0
JaseS
• 21
• 17
1 Solution

Commented:
File Attached. Run the macro Sample() in the module. I have cleared the values in the respective columns so that you can test it.

Hope this is what you wanted?

Sid

Code Used

``````Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long
Dim Temp, x As Long

Set ws = Sheets("Goga Tora")

LastRow = ws.Range("D" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
x = 7
Temp = ws.Range("D" & i).Value

If Len(Trim(Temp)) <> 0 Then
If Temp < 2001 Then
ws.Cells(i, x).Value = Temp
Else

Do While Temp > 2000
Temp = Temp - 2000
ws.Cells(i, x).Value = 2000
x = x + 4
Loop
If Temp < 2001 Then ws.Cells(i, x).Value = Temp
End If
End If
Next
End Sub
``````
Consolidate1.xls
0

Author Commented:
no, not quite, sorry.

I need the amounts divided as they are per date in the example originally posted.
Also, for each amount and date created, I need the row of data filled out along with the date and amount for the date. Please refer back to my original file to see what the end result needs to look like.

0

Author Commented:
maybe the attache will help?
0

Commented:
You mean like this?

Please run the sample in module.

Sid

Code Used

``````Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long
Dim Temp, x As Long, i As Long

Set ws = Sheets("Goga Tora")

LastRow = ws.Range("D" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
x = i
Temp = ws.Range("D" & i).Value

If Len(Trim(Temp)) <> 0 Then
If Temp < 2001 Then
ws.Cells(i, 7).Value = Temp
Else

Do While Temp > 2000
Temp = Temp - 2000
ws.Cells(x, 7).Value = 2000
x = x + 1
Loop
If Temp < 2001 Then ws.Cells(x, 7).Value = Temp
End If
End If
Next

LastRow = ws.Range("G" & Rows.Count).End(xlUp).Row

ws.Range("G2:G" & LastRow).Copy

ws.Range("K2,O2,S2,W2,AA2,AE2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False
End Sub
``````
Consolidate1.xls
0

Author Commented:
getting there -

you divided Col D up correctly for each client, but the code needs to run when an amount is input into column D, then reproduce the entire row from above, inserting the parsed amounts (as you correctly did for each client) and ALSO, create a date until the entire amount in Col D is used up. As mentioned, the dates cannot be weekend dates.
0

Commented:
Oh Ok...

Just to reconfirm you want

1) The macro should run only if a value is entered in Col D
2) Split the amount
3) populate dates till the last cell of the amount
4) Copy the similar data from top.

Am I correct?

Sid
0

Author Commented:

1. yes
2. yes, into 2,000 increments until all used up - the amount in Col D refers to how much each client is to receive
3. yes
4. yes, need the credit card number, names etc, everything from the row above, EXCEPT for the amount that you are parsing for each client equally, until Col D amount is all used up
0

Commented:
few moments :)

Sid
0

Commented:
For testing purpose I changed the date to 3/25/11 in cell E2

The marco will run the moment you make a change in Col B. I have not taken Col D as it is being derived from Col B

Sid

Code Used

``````Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim LastRow As Long
Dim Temp, x As Long, i As Long

LastRow = Range("D" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
Application.EnableEvents = False

If Not Intersect(Target, Range("B2:B" & LastRow)) Is Nothing Then
x = Target.Row
Temp = Target.Offset(, 2).Value

If Len(Trim(Temp)) <> 0 Then
If Temp < 2001 Then
Cells(i, 7).Value = Temp
Else
Do While Temp > 2000
Temp = Temp - 2000
Cells(x, 7).Value = 2000
x = x + 1
Loop
If Temp < 2001 Then Cells(x, 7).Value = Temp
End If
End If
LastRow = Range("G" & Rows.Count).End(xlUp).Row

Range("G" & Target.Row & ":G" & x).Copy

Range("K" & Target.Row & ",O" & Target.Row & ",S" & Target.Row & ",W" & Target.Row _
& ",AA" & Target.Row & ",AE" & Target.Row).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False
Range("F" & Target.Row).AutoFill Destination:=Range("F" & Target.Row & ":F" & x), Type:=xlFillDefault
Range("H" & Target.Row & ":J" & Target.Row).AutoFill Destination:=Range("H" & Target.Row & ":J" & x)
Range("L" & Target.Row & ":N" & Target.Row).AutoFill Destination:=Range("L" & Target.Row & ":N" & x)
Range("P" & Target.Row & ":R" & Target.Row).AutoFill Destination:=Range("P" & Target.Row & ":R" & x)
Range("T" & Target.Row & ":V" & Target.Row).AutoFill Destination:=Range("T" & Target.Row & ":V" & x)
Range("X" & Target.Row & ":Z" & Target.Row).AutoFill Destination:=Range("X" & Target.Row & ":Z" & x)
Range("AB" & Target.Row & ":AD" & Target.Row).AutoFill Destination:=Range("AB" & Target.Row & ":AD" & x)
Range("AF" & Target.Row & ":AG" & Target.Row).AutoFill Destination:=Range("AF" & Target.Row & ":AG" & x)

dt = Range("E" & Target.Row).Value

For i = Target.Row + 1 To x
dt = dt + 1
If Left(WeekdayName(Weekday(dt)), 3) = "Sat" Then
dt = dt + 2
ElseIf Left(WeekdayName(Weekday(dt)), 3) = "Sun" Then
dt = dt + 1
End If
Cells(i, 5).Value = dt
Next
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
``````
Consolidate1.xls
0

Author Commented:
Strange, I was waiting for an email showing you responded but didn't get one. Just saw your post, sorry.

Grabbed your sheet, entered a value into Col B and nothing happened. Oh! It does work as long as I put a value in cell B2, but if I put a value anywhere else in col B, which I will do as new Remitted Amounts come in, it doesn't do anything.

Also, I noticed that if I changed the amount in cell B2, C2 and D2 update but not the amounts in the Amount columns.

Btw, thanks for basing it off Col B. Good idea.
0

Commented:
Yes this is for testing purpose it will only work with B2 at the moment.

My suggestion would be not to base it against any changes in the worksheet but run a macro once you have entered all the values. Would that be OK? If yes, then I will make the relevant changes.

Sid
0

Author Commented:
I suppose we could run it with a button click although I prefer it to run once an amount is put in. Just curious why you'd rather do it that way?
0

Author Commented:
Are we still working on this SiddarthRout? I hope so. Really hoping to have this work for me.
0

Commented:
>>>> I suppose we could run it with a button click although I prefer it to run once an amount is put in.

Yes even I suggest that :)

>>>Just curious why you'd rather do it that way?

That is because between two "Remitted Amount" there will be blank spaces. Let me create a sample for you.

Sid
0

Commented:
Ok Try this. After you have filled the data, run the macro Sample in the module.

Sid

Code Used

``````Option Explicit

Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long
Dim Temp, x As Long, i As Long, j As Long
Dim dt As Date

Set ws = Sheets("Goga Tora")

With ws
LastRow = .Range("D" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
Application.EnableEvents = False

For i = 2 To LastRow
x = i
Temp = .Range("D" & i).Value

If Len(Trim(Temp)) <> 0 Then
If Temp < 2001 Then
.Cells(i, 7).Value = Temp
Else
Do While Temp > 2000
Temp = Temp - 2000
.Cells(x, 7).Value = 2000
x = x + 1
Loop
If Temp < 2001 Then .Cells(x, 7).Value = Temp
End If

.Range("G" & i & ":G" & x).Copy

.Range("K" & i & ",O" & i & ",S" & i & ",W" & i _
& ",AA" & i & ",AE" & i).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False
.Range("F" & i).AutoFill Destination:=.Range("F" & i & ":F" & x), Type:=xlFillDefault
.Range("H" & i & ":J" & i).AutoFill Destination:=.Range("H" & i & ":J" & x)
.Range("L" & i & ":N" & i).AutoFill Destination:=.Range("L" & i & ":N" & x)
.Range("P" & i & ":R" & i).AutoFill Destination:=.Range("P" & i & ":R" & x)
.Range("T" & i & ":V" & i).AutoFill Destination:=.Range("T" & i & ":V" & x)
.Range("X" & i & ":Z" & i).AutoFill Destination:=.Range("X" & i & ":Z" & x)
.Range("AB" & i & ":AD" & i).AutoFill Destination:=.Range("AB" & i & ":AD" & x)
.Range("AF" & i & ":AG" & i).AutoFill Destination:=.Range("AF" & i & ":AG" & x)

dt = .Range("E" & i).Value

For j = j + 1 To x
dt = dt + 1
If Left(WeekdayName(Weekday(dt)), 3) = "Sat" Then
dt = dt + 2
ElseIf Left(WeekdayName(Weekday(dt)), 3) = "Sun" Then
dt = dt + 1
End If
.Cells(j, 5).Value = dt
Next
End If
Next
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
``````
Consolidate1-1.xls
0

Author Commented:
Ok, thanks Sid. I'll try it later tonight. Caught up in some timely stuff right at the moment.
0

Author Commented:
Ran the code on your xls file and it worked... and it didn't.

Looking at the attached image, you can see that it correctly filled in the amounts for the grid that was there, but I'm needing it also to recreate that grid while inputting the correct amount in and it would be best if the code is initiated once an amount is input into Col D. Maybe you're already planning on that.
0

Commented:
I am not sure what you mean?

Sid
0

Author Commented:
As posted on 3/26 from above:

"you divided Col D up correctly for each client, but the code needs to run when an amount is input into column D, then reproduce the entire row from above, inserting the parsed amounts (as you correctly did for each client) and ALSO, create a date until the entire amount in Col D is used up. As mentioned, the dates cannot be weekend dates."

Does that make sense?

0

Commented:
So everything is working fine but you want the macro to run when there is a change in D?

Sid
0

Author Commented:
No, as described, everything is not working. The code only inputs the amounts into the grid that was already created. It needs to RE-create the grid, filling in the parsed amounts as well.
0

Commented:
Sorry. Today is a 'slow' day for me :(

Are you talking about populating columns F, H, I, J etc?

Sid
0

Author Commented:
Yes, but as you may remember, we pull F,H,I and J down from the row above when a value is inserted into Col D. It then parses the amount in D in 2000 increments until finished, at the same time, inputting the date (not including weekends) in Col E.
0

Author Commented:
Hi Sid,

Just wondering where we're at with this now.
0

Commented:
I think I understand you now however one Last question.

If I am populating say row 9 then I can get the values from the previous row for Cols F, H I etc. But what if I am populating Row 2? From where do I get the data for those cols?

Sid

0

Author Commented:
don't worry about that. There will always be data, a row with data, that it can pull from
0

Commented:
Like this?

I filled the values in Col A-E in the new row. Simply run the macro.

Sid
Consolidate1-1.xls
0

Author Commented:
Does your function run automatically when I put a value in D? Because, that's what I'm needing and it's not doing it with your xls file.
0

Commented:
JaseS: D has a formula. As mentioned few posts above, it is a bad idea to base it on cell change as the macro will run every time there is a change in the cell. The best way is to fill all the values in Col A - E and then run the macro.

Sid
0

Author Commented:
Ran the code after inputting data in A - E and if comes up with an error,
with this portion of the code highlighted in yellow:
.Range("F" & i).AutoFill Destination:=.Range("F" & i & ":F" & x), Type:=xlFillDefault
0

Commented:
Strange, I am not getting the error. Please see the screencast.

I am using the same file that I uploaded in ID: 35307756

Sid
SiddharthRout-439964.flv
0

Author Commented:
Ok, now it runs - not sure why now - but there is something odd going on with the date column. It changes it up and also put a date in the header.

Also looking at image Consolidate 4c it's doing something odd with these cells
consolidate4c.gif
0

Author Commented:
will be out for a number of hour today, just in case you're looking for me to respond quickly
0

Commented:
I am almost done. Just testing it.

Sid
0

Commented:

Sid
Consolidate1-1.xls
0

Author Commented:
it worked for a couple of times, but the latest produced an error:
0

Author Commented:
It's strange. I'll run the code for about five times and it works, and then for some reason it produces the above error. However, if I delete what ever caused the error and begin again, it works. So I'm just going to call this done.
0

Author Commented:
A rather complicated project, but SiddharthRout understood what was needed and did it. Will help me a lot and save a lot of time.

Thank you!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Featured Post

• 21
• 17
Tackle projects and never again get stuck behind a technical roadblock.