Solved

Parsing amounts to dates

Posted on 2011-03-25
38
167 Views
Last Modified: 2012-05-11
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
Comment
Question by:JaseS
  • 21
  • 17
38 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35217419
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
 

Author Comment

by:JaseS
ID: 35217518
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 Comment

by:JaseS
ID: 35217762
maybe the attache will help? parsing
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35217835
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
 

Author Comment

by:JaseS
ID: 35217893
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35217922
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 Comment

by:JaseS
ID: 35218089

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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35218093
few moments :)

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35218199
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
 

Author Comment

by:JaseS
ID: 35219555
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35221024
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 Comment

by:JaseS
ID: 35222183
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 Comment

by:JaseS
ID: 35240591
Are we still working on this SiddarthRout? I hope so. Really hoping to have this work for me.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35244862
>>>> 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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35244991
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
 

Author Comment

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

Author Comment

by:JaseS
ID: 35280670
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35280827
I am not sure what you mean?

Sid
0
 

Author Comment

by:JaseS
ID: 35280973
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
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 30

Expert Comment

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

Sid
0
 

Author Comment

by:JaseS
ID: 35282760
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35284006
Sorry. Today is a 'slow' day for me :(

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

Sid
0
 

Author Comment

by:JaseS
ID: 35284382
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 Comment

by:JaseS
ID: 35305751
Hi Sid,

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

Expert Comment

by:SiddharthRout
ID: 35307117
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 Comment

by:JaseS
ID: 35307740
don't worry about that. There will always be data, a row with data, that it can pull from
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35307756
Like this?

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

Sid
Consolidate1-1.xls
0
 

Author Comment

by:JaseS
ID: 35307829
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35307882
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 Comment

by:JaseS
ID: 35309398
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35309416
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 Comment

by:JaseS
ID: 35309529
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
 

Author Comment

by:JaseS
ID: 35309610
will be out for a number of hour today, just in case you're looking for me to respond quickly
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35309612
I am almost done. Just testing it.

Sid
0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 500 total points
ID: 35309620
Please check this.

Sid
Consolidate1-1.xls
0
 

Author Comment

by:JaseS
ID: 35310618
it worked for a couple of times, but the latest produced an error: Error Message Error Code
0
 

Author Comment

by:JaseS
ID: 35311598
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 Closing Comment

by:JaseS
ID: 35311705
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

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

A2 = A1 That kind of cell reference is relative.  If you copy it from A2 to B2, then B2 will get this: B2 = B1 That's all fine and good, but if you then insert a new row above row 2, you'll find: A3 = A1 B3 = B1 This is intentional. …
Dealing with unintended Excel Active-X resizing quirks (VBA code simulates "self correction") David Miller (dlmille) Intro Not everyone is a fan of Active-X controls in spreadsheets (as opposed to the UserForm approach, the older Form controls …
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now