Dublicate row based on first 6 letters in Cell and paste to buttom, changing date and divide amount

[Konigsfeldt]

Hi all,

I have rows with budget amounts that are totals for a year, but want to split them into 4 in same sheet, changing the date from 01-01-20XX to 01-01, 01-04, 01-07 & 01-10 and furthermore divide the amount with 4. (So I can compare with actuals by quarter when pivoting)

The variable is in column "A", and says "Budget 2020", but next year it will say 2021, and so on - so it has to be "Budget" only, that determines whether it should be dublicated or not. Column "A" contains the value "Actual" as well. The sheet is called "Rawdata".

The code should do the following, from:

to:

Hope it makes sense, please reach out for further info if necessary.

Thanks in advance for any help received.

/Jacob

 

[braindiesel]

From this table

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Label	Other Labels	Other Labels	Other Labels	DATE	Other Labels	Other Labels	Other Labels	Other Labels	Other Labels	Other Labels	Other Labels	Amount
2	Budget 2020	STUFF	STUFF	STUFF	2020	STUFF	STUFF	STUFF	STUFF	STUFF	STUFF	STUFF	100000
3	Budget 2020	STUFF	STUFF	STUFF	2020	STUFF	STUFF	STUFF	STUFF	STUFF	STUFF	STUFF	200000
4	Actual 2020	STUFF	STUFF	STUFF	2020	STUFF	STUFF	STUFF	STUFF	STUFF	STUFF	STUFF	200001
5	Budget 2020	STUFF	STUFF	STUFF	2020	STUFF	STUFF	STUFF	STUFF	STUFF	STUFF	STUFF	400000
6	Budget 2020	STUFF	STUFF	STUFF	2020	STUFF	STUFF	STUFF	STUFF	STUFF	STUFF	STUFF	500000
7	Budget 2020	STUFF	STUFF	STUFF	2020	STUFF	STUFF	STUFF	STUFF	STUFF	STUFF	STUFF	600000
Sheet1

with this code

Sub quarterMe()
    Range("E2").Select
    If ActiveCell.Offset(1, 0).Value <> "" Then
        Selection.End(xlDown).Select
        End If
    myDest = Selection.Offset(2, 0).Row
    stopHere = Selection.Offset(1, 0).Row
    Range("E2").Select
    myRow = ActiveCell.Row
    
    
    Do Until myRow = stopHere
        myLeft = Left(Range("A" & myRow).Value, 6)
        myRight = Right(Range("A" & myRow).Value, 4)
        'Depending on your version, you may ned to put myLeft = Application.worksheetfunction. before the Left and Right in the above two lines
        'ex:myLeft = Application.worksheetfunction.Left(Range("A" & myRow).Value,6)
        Range("A" & myRow & ":M" & myRow).Copy Destination:=Range("A" & myDest & ":M" & myDest)
        
        If myLeft = "Budget" Then
            Range("A" & myDest & ":M" & myDest + 3).Select
            Selection.FillDown
            Range("E" & myDest).Select
            ActiveCell = DateSerial(Month:=1, Day:=1, Year:=myRight)
            ActiveCell.Offset(1, 0).Value = DateSerial(Month:=4, Day:=1, Year:=myRight)
            ActiveCell.Offset(2, 0).Value = DateSerial(Month:=7, Day:=1, Year:=myRight)
            ActiveCell.Offset(3, 0).Value = DateSerial(Month:=10, Day:=1, Year:=myRight)
            Range("M" & myDest).Resize(4, 1).Value = Range("M" & myDest).Value / 4
            myDest = myDest + 4
        
        
            Else
            myDest = myDest + 1
        
        End If
        myRow = myRow + 1
            
    Loop
    Range("A1").Select
    
End Sub

You will see a bunch of ranges refer to "M"... that was the final column I used... you may need to adjust that.

Hope this helps

 

[Konigsfeldt]

Thanks a lot!

I get this error:

 

[Konigsfeldt]

Probably more variables that needs to be defined - could you help with that?

 

[Konigsfeldt]

I also noted that column "C" contains the "Budget" variable, I don't kow if that is easier to use in the code, rather than using Left/right functions on cells in column "A".

 

[braindiesel]

somewhere between the first line and the Variable line add this
mydest as long
or
Dim myDest as long

that should solve it

 

[Konigsfeldt]

Thanks,

I dimmed the variables as follows, and it almost works as I want.

Remember that column "C" contains the "Budget" information if that makes the code more smooth or easier to write.

Sub quarterMe()
Dim myDest As Long
Dim stopHere As Long
Dim myRow As Long
Dim myLeft As String
Dim myRight As String

Right now it takes the entire dataset and duplicates it, doing the right thing with budget rows but just copies the row if it's an actual.

1) Is it possible to skip the one blank row between original data and pasted data?

2) Is it possible to end the code after it has copied and divided the budget rows, instead of it continuing with copy pasting actual rows? Budget rows would always be the first rows, not mixed in where between actual rows.

3) Finally, maybe the most tricky part, when the budget rows is quatered, the original budget row still exists, but when making a pivottable from the data, the budget totals would now be twice the value as it should. Is it possible to delete the original row? Potentially this row could also just be quartered, and then the first bugdet row shouldn't be made (date 1. jan 20XX).

Hope it makes sense, and again, thanks a lot.

/Jacob

 

[Konigsfeldt]

Hi all,

I have rows with budget amounts that are totals for a year, but want to split them into 4 rows in same sheet, changing the date from 01-01-20XX to 01-01, 01-04, 01-07 & 01-10 and furthermore divide the amount with 4. (So I can compare with actuals by quarter when pivoting)

The variable is in column "C", and says "Budget", which determines whether it should be quartered or not. Column "C" contains other values as well, such as "Actual" and "Opening post", and those should be skipped - but all budget rows should be quartered and pasted to the bottom (or anywhere in the dataset, as long as the entire dataset can be marked with crtl+shift+down). The sheet is called "Rawdata", and lastrow is column "AB".

The code should do the following (example with first budget row):

to:

Hope it makes sense!

Thanks for any help on this.

/Jacob

 

[Konigsfeldt]

somewhere between the first line and the Variable line add this
mydest as long
or
Dim myDest as long

that should solve it

Hey braindiesel

Did you see my post below? I'm not capable of modifying your code to suit my needs, and I think it needs some small changes.

Could you help?

Thanks

 

[Konigsfeldt]

Alternatively the code would run but the data would be pasted in a seperate sheet instead of at the end of the data?