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

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
Asked:
JaseS
  • 21
  • 17
1 Solution
 
SiddharthRoutCommented:
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

Open in new window

Consolidate1.xls
0
 
JaseSAuthor 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
 
JaseSAuthor Commented:
maybe the attache will help? parsing
0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
SiddharthRoutCommented:
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

Open in new window

Consolidate1.xls
0
 
JaseSAuthor 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
 
SiddharthRoutCommented:
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
 
JaseSAuthor 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
 
SiddharthRoutCommented:
few moments :)

Sid
0
 
SiddharthRoutCommented:
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

Open in new window

Consolidate1.xls
0
 
JaseSAuthor 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
 
SiddharthRoutCommented:
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
 
JaseSAuthor 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
 
JaseSAuthor Commented:
Are we still working on this SiddarthRout? I hope so. Really hoping to have this work for me.
0
 
SiddharthRoutCommented:
>>>> 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
 
SiddharthRoutCommented:
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

Open in new window

Consolidate1-1.xls
0
 
JaseSAuthor Commented:
Ok, thanks Sid. I'll try it later tonight. Caught up in some timely stuff right at the moment.
0
 
JaseSAuthor 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. screenshot
0
 
SiddharthRoutCommented:
I am not sure what you mean?

Sid
0
 
JaseSAuthor 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
 
SiddharthRoutCommented:
So everything is working fine but you want the macro to run when there is a change in D?

Sid
0
 
JaseSAuthor 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
 
SiddharthRoutCommented:
Sorry. Today is a 'slow' day for me :(

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

Sid
0
 
JaseSAuthor 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
 
JaseSAuthor Commented:
Hi Sid,

Just wondering where we're at with this now.
0
 
SiddharthRoutCommented:
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
 
JaseSAuthor Commented:
don't worry about that. There will always be data, a row with data, that it can pull from
0
 
SiddharthRoutCommented:
Like this?

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

Sid
Consolidate1-1.xls
0
 
JaseSAuthor 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
 
SiddharthRoutCommented:
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
 
JaseSAuthor 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 error message screehshot
0
 
SiddharthRoutCommented:
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
 
JaseSAuthor 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
 BEFORE AFTER - NOTE DATE COLUMN consolidate4c.gif
0
 
JaseSAuthor Commented:
will be out for a number of hour today, just in case you're looking for me to respond quickly
0
 
SiddharthRoutCommented:
I am almost done. Just testing it.

Sid
0
 
SiddharthRoutCommented:
Please check this.

Sid
Consolidate1-1.xls
0
 
JaseSAuthor Commented:
it worked for a couple of times, but the latest produced an error: Error Message Error Code
0
 
JaseSAuthor 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
 
JaseSAuthor 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.

Join & Write a Comment

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

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