CONVERT DATA with ROUNDUP and ROUNDDOWN functionality using vba

[ChrisOK]

I've got a data dump that must be edited/converted prior to pushing it into a different main frame system. There can be NO decimals in the end result. Here's the challenge:

______Col A____Col B___Col C___Col D____Col E
Row1__TOT_____1Q_______2Q_____3Q______4Q_____
Row2__20.00____5.00_____5.00____5.00____5.00___
Row3__26.00____6.50_____6.50____6.50____6.50___
Row4___0.00____0.00_____0.00____0.00____0.00___
Row5_139.00___34.75____34.75___34.75___34.75___
Row6__13.00____3.25_____3.25____3.25____3.25___

Starting on Row 2, there's a break down of 4 quarters of data divisible by 4 using the whole number TOTAL of Parts in Col A.

The analyst must first break it down into 4 parts (as done in Col B through E)
Then, round up and down appropriately to ensure that NO DECIMAL data is entered into another main frame system.

THE PROBLEM/CHALLENGE:
Can't copy one formula downward because if it ends in .50, the up/down sequence is diff from how it would be rounded if it ended with .75.

SOLUTION:
Need vba to be smart enough to evaluate "IF" and apply "THEN" according to what it sees in Col B's data and convert B, C, D and E appropriately. (I will tie this to a button within a toolbar to run the macro/vba when the conversion of B thru E is needed.

EXAMPLE:
IF B's data ends in: xx.00 or xx.50, then convert those 4 quarter's data accordingly:
ROUNDUP, ROUNDdown, ROUNDUP, ROUNDdown, (this one doesnt really matter but works)

IF B's data ends: xx.25, then convert those 4 quarter's data accordingly:
ROUNDUP, ROUNDdown, ROUNDdown, ROUNDdown,

IF B's data ends: xx.75, then convert those 4 quarter's data accordingly:
ROUNDUP, ROUNDUP, ROUNDUP, ROUNDdown,


Using ROW 6 as an example for how to handle xx.25's:
B6 would convert up to 4
C6 would convert down to 3
D6 would convert down to 3
E6 would convert down to 3
TOTAL after conversion = 13

 

[Momentman]

Give this code a try, it just needs the values in column A and does every other from there

Sub NEWMACRO()    Dim wf As WorksheetFunction
    Set wf = Application.WorksheetFunction
    lastrow = Range("A1").End(xlDown).Row
    
    For I = 2 To lastrow
        ask = Format(Range("A" & I).Value / 4, "#.00")
        ask2 = Right(ask, 3)
        wf2 = wf.RoundUp(ask, 0)
        wf3 = wf.RoundDown(ask, 0)
        If ask2 = ".00" Or ask2 = ".50" Then
            Range("B" & I).Value = wf2
            Range("C" & I).Value = wf3
            Range("D" & I).Value = wf2
            Range("E" & I).Value = wf3
        ElseIf ask2 = ".25" Then
            Range("B" & I).Value = wf2
            Range("C" & I).Value = wf3
            Range("D" & I).Value = wf3
            Range("E" & I).Value = wf3
        ElseIf ask2 = ".75" Then
            Range("B" & I).Value = wf2
            Range("C" & I).Value = wf2
            Range("D" & I).Value = wf2
            Range("E" & I).Value = wf3
        End If
    Next I
End Sub

 

[ChrisOK]

AWESOME!!! Momentman! Wish you could hear the cheers! Had no idea something like this could be done - but >hoped<
You don't know how happy you've just made my analysts! Much thanks!
(I clicked "Like" on your post to mk sure you get credit)

 

[ChrisOK]

...an afterthought, is there a way to have the vba take what was just converted in B, C, D, E and paste it over to another sheet within the same workbook...?
Keeping it simple, let's say:
B1, C1, D1, E1 of Sheet1 would paste as values into Sheet2 cells G1, H1, I1, J1 (and copy downward until done) (copy within same workbook)

Using a separate chunk of code that I could attach to another button (because the analyst may not want to do it all in one blow) - but they did, I could just paste it beneath what is already there performing the conversion.

 

[Momentman]

Thanks for the kind words, I actually heard the cheers

Wondering why you want to paste as values elsewhere 'cos the code just puts in the values in B,C,D,E and no formulas but in any case, that shouldn't be any problem. Something like this

Sub Macro3()
Dim wks As Worksheet
    Dim wks2 As Worksheet
    
    Set wks = Worksheets("Sheet1")
    Set wks2 = Worksheets("Sheet2")
    
    lastrow = wks.Range("A1").End(xlDown).Row
    
    wks.Range("B2:E" & lastrow).Copy
    wks2.Activate
    Range("G1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
End Sub

 

[ChrisOK]

Well, to be honest, it's an archaic govmt system nightmare -- I saw someone doing updates manually today and started dissecting the steps needed to automate it a bit...

We get a data dump via "NOTE" .txt text file where everything is CONCATENATED together... (small example below)
Part # and quantities for several Quarters and several Yrs outward. (this data is the existing database Quantities dump that must be updated with newly forecasted Quantities!)


.txt FILE LOOKS SIMILAR TO THIS: (not easy to read or update)
1234500000000000750000000000007500000000000007500000000000007500000000000XYZXYZ
2222200000000000530000000000005300000000000005300000000000005300000000000YSGDHR
3333300000000000130000000000001300000000000001300000000000001300000000000PWNJDK

We also get another file (xls) that holds the newly forecasted quantities that ultimately need to be inserted into that flat file/NOTE txt file concatenated format. (or we can simply create a new .txt file which is what we do)

Within that xls, it basically has a 2 column list that says we need:
300 of part #12345
212 of part #22222
52 of part #33333
and so on....

Our job is to spread that 300 out as equally as possible across the 4 Quarters.

I created a 2nd tab of that xls to perform the calculations (takes the new .xls Quantities and divides them by 4 and populates 4 columns in a 'quarterly' columnar format)....

Once that's done, we were posed with the issue that you helped resolve (getting rid of the decimals) because the archaic system won't allow decimals.

Next, there's a 3rd tab in the xls that is linked to the 2nd calculating tab...(it gets auto-fed via link from the 2nd tab)
That 3rd tab is the one that gets converted into whole numbers using the toolbar macro (because we don't want to overwrite what's happening on the 2nd tab).

The 4th tab is the final dumping place where (once it is copied over/dumped) it gets automatically CONCATENATED back into the format of the NOTE .txt file so that the new data can be copied and pasted into a .txt NOTE file, then emailed to another dept to upload it back into the main frame system.

VBA can probably be written to do all these steps in one swoop and in one sheet, but we'd lose *visibility* of what's happening as far as calculations occurring properly, being spread out properly across several quarters and years.... so, I've got it in a 4 step process with (some) automation whereas, previous to today, a poor soul was forced to edit the .txt file while going blind -- trying to read between hundreds of lines filled with zeros.

~sigh~ I know, I know, painful but true

 

[ChrisOK]

For some reason, I keep getting an "out of range" error on line 4?

Set wks = Worksheets("Sheet1")

Any ideas?

 

[Momentman]

Do you have a worksheet called sheet1? if you dont, thats the only reason why it should fail

 

[ChrisOK]

Got it working. I thought the code would be looking at the tab/sheet for its real name looking at it from the vba back side. Found that once I edited the code to refer to the renamed name it works great!

 

[Momentman]

Good to know