Create a macro to copy formula based on certain criteria

xllvr
xllvr used Ask the Experts™
on
Hello Experts,

I have mocked up some data as an example of what I'm trying to achieve.  Sadly, the data is not how I would structure it, but my hands are tied.  This data is ripe for a pivot table.  Not sure how I could clean up the data to provide a contiguous block of information to pivot off of without creating a new column for an account number.

The person I am doing this for showed me the structure I have provided here in the attached file.  I want to create a macro (Do While or Until?) that copies the formulas down but also totals by Account (the shaded rows).  Hopefully, this will be clearer when you see the mock up.

If I could assign more points, I would! Totals-macro.xlsx
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Most Valuable Expert 2012
Top Expert 2012

Commented:
Here's the code that copies range N6:R6 down to the last row where there's data in column M (balance column).
Sub CopyDown()
Dim mySheet As Worksheet
Dim rToCopy As Range
Dim lastRow As Long

    Set mySheet = ActiveSheet
    Set rToCopy = Range("N6:R6")
    
    lastRow = mySheet.Range("M" & mySheet.Rows.Count).End(xlUp).Row
    
    rToCopy.Resize(lastRow - rToCopy.Row + 1).FillDown
    
End Sub

Open in new window

What's confusing is the request for totals.  do you really want to change this formula?  Because the formula you wrote references totals on the total line, so it should already reflect the total, should it not?

Please let me know...

Dave
Totals-macro-r1.xlsm

Author

Commented:
I'm sorry I didn't convey that request clearly.  The person I'm helping needs, for example, Row 9 to sum everything above it in Columns N through R.  The same goes for Row 23,and so on.

That's why I wish this could be a Pivot Table instead.  It would mean that the Account numbers referenced in Rows 9 and 23 would have to be carried over into their own column and assigned a spot in each row (e.g., Rows 6-8 would have 1234567 in a new column called, let's say, Code #).  Then the data could be grouped by that variable as well as month.

Another issue that just occurred to me after seeing your code is that this person will be using this macro in different files so N6:R6 might not always be the range.  How would I deal with that?  Would I place the formulas in a personal macro workbook and use relative references?

I wish this were less complicated for both our sakes.  Thank you for taking a look at this!
Most Valuable Expert 2012
Top Expert 2012

Commented:
well - if you don't need lines 9,10,23,24 etc., and columns N-R, the rest could be converted to a pivot table, easily.  Would you like a macro to do that, instead?  where the account number column is populated?

Let me know as I'm almost done with the request as originally stated...

Dave
C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

Author

Commented:
Hi Dave,

Just to clarify:  a new column would be inserted, and the account code number which is sharing the same column with other data would have to be extracted and copied into all the rows where it applies.  Then it would be ok to delete those rows you mentioned.

Could we finish out the original request (which means adding the SUM formula to N9:R9, and rows like it) to your macro?  I'd be happy to start a new question with the pivot table idea so you'd get more points.  Will that work?

Thank you!
Most Valuable Expert 2012
Top Expert 2012

Commented:
ok - I'll put that on the backburner...

Author

Commented:
The person I'm doing this for seems pretty rigid in wanting to keep the original data as is.  I'd like to offer up the Pivot Table idea so he can see the benefit.  I just don't know how to automate the addition of that column and deletion of the total rows.  The rest is easy.

Just let me know when you'd like me to submit a new question.  I don't want to do it if you're not ready...that is if you even want to take this on!

thanks!
Most Valuable Expert 2012
Top Expert 2012

Commented:
The pivot data can be on another sheet  not ready yet - just finishing this.
Most Valuable Expert 2012
Top Expert 2012
Commented:
Ok - check this.

Here's the code:

 
Sub CopyDown()
Dim mySheet As Worksheet
Dim rToCopy As Range
Dim lastRow As Long
Dim rSubTotals As Range
Dim firstAddr As String
Dim rCopyOut As Range
Dim rSumTop As Range, rSumBottom As Range
Dim lSumTop As Long, lSumBottom As Long
Dim rSum As Range, lRng As Range, lColumns As Long

    Set mySheet = ActiveSheet
    Set rToCopy = Selection
    lColumns = rToCopy.Columns.Count
    
    lastRow = mySheet.Range("M" & mySheet.Rows.Count).End(xlUp).Row
    
    rToCopy.Resize(lastRow - rToCopy.Row + 1).FillDown
    
    With mySheet.Range("D:D")
        Set rSubTotals = .Find(what:="Total", lookat:=xlPart)
                
        If Not rSubTotals Is Nothing Then
            firstAddr = rSubTotals.Address
            
            Do
                Set rSumBottom = mySheet.Range("B" & rSubTotals.Offset(-1, 0).Row)
                lSumBottom = rSumBottom.Row
                
                If rSumBottom.Offset(-1, 0).Value = "" Then
                    lSumTop = rSumBottom.Row
                Else
                    lSumTop = rSumBottom.End(xlUp).Row
                End If
                
                Set rSum = mySheet.Range(mySheet.Cells(lSumTop, rToCopy.Cells(1, 1).Column), mySheet.Cells(lSumBottom, rToCopy.Cells(1, 1).Column))
                
                Set lRng = mySheet.Cells(rSubTotals.Row, rToCopy.Cells(1, 1).Column)
                
                lRng.Formula = "=SUM(" & Replace(rSum.Address, "$", "") & ")"
                
                lRng.Resize(, lColumns).FillRight
                
                lRng.Resize(, lColumns).Interior.Color = lRng.Offset(0, -1).Interior.Color
                
                Set rSubTotals = .FindNext(rSubTotals)
            Loop While Not rSubTotals Is Nothing And rSubTotals.Address <> firstAddr
        End If
    End With
End Sub

Open in new window


SELECT the range with the formulas to be copied down - e.g., N6:R6, then run the macro.

Enjoy!

See attached,

Dave
Totals-macro-r2.xlsm
Most Valuable Expert 2012
Top Expert 2012

Commented:
ok - give me a file with the ORIGINAL data, no additions of columns or anything.  Thanks

Dave

Author

Commented:
Apologies...was on a client call.  I will check out the macro now.  Would you like me to send you the data as a new question so I can give you more points?
Most Valuable Expert 2012
Top Expert 2012

Commented:
I'm happy to work the new question.  Need to see the raw data for that, as it looks like you've messed with the original, so not sure on some things.

I assume you want a pivottable something like this?
 pivot viewGo ahead and post question with original data and desired "Look" of pivot table.

Cheers,

Dave
Most Valuable Expert 2012
Top Expert 2012

Commented:
and ensure the experts, in your posted question, that the format will be the same (e.g., column A description will always be date, or whatever).

Cheers,

Dave

Author

Commented:
Again, apologies for not being available for those 30 minutes.  Here is the file.  I think this is what you're after.  I just copied the older tab and cleared the extraneous information. Totals-macro-Pivot.xlsm

Author

Commented:
The PT layout looks correct at first glance.

Author

Commented:
I have an appointment for the next hour but am submitting new question now.  hate to abandon you!

Author

Commented:
David,

I want to wait to submit the other question.  I feel like I'm rushing and haven't thought it through as thoroughly as I'd like to catch all the implications.  That wouldn't be fair to you, especially as I go off to a meeting.  I will likely revisit this tomorrow.  Thank you soooo much for all your help thus far!  It is very much appreciated!  Again, more points if I could!
Most Valuable Expert 2012
Top Expert 2012

Commented:
be sure to click the ASK A RELATED QUESTION so those of us monitoring this one will be alerted when you add the new one...  That link for related question is just here where you type responses.

Dave

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial