autosum vba question

hi all-
need some assistance please. currently i have a macro that runs a few different subs that filters criteria into different sheets within a workbook.

i then autosum a specific column. all this works as expected.

however, now i want to take the value of the autosum from each tab, copy and paste into a newly created tab.

how can i go about doing this? i have the 2 filtered functions separated as Subs, and the autosum is a sub as well. See below.

Sub RUN()
FilterEQ Worksheets("Filtered from Results")
FilterFX Worksheets("Filtered from Results")
End Sub

Sub FilterEQ(ws As Worksheet)
'start filter code
Dim rg As Range, rgCopy As Range
With ws
    Set rg = .Range("O1").CurrentRegion
    Set rgCopy = rg.Offset(1, 0).Resize(rg.Rows.Count - 1, rg.Columns.Count)
    iCol = .Range("O:O").Column - rg.Column + 1
    rg.AutoFilter
    rg.AutoFilter Field:=iCol, Criteria1:="EQ"
    rgCopy.Copy
    With Worksheets.Add(After:=Worksheets(Worksheets.Count))       'Destination worksheet
        .Cells(1, 1).PasteSpecial xlPasteValues
        Cells(1, 1).Select
        .Name = "EQ"
    End With
    rg.AutoFilter
    'Auto Sum test
    AutoSum
End With
End Sub
Sub FilterFX(ws As Worksheet)
'start filter code
Dim rg As Range, rgCopy As Range
With ws
    Set rg = .Range("O1").CurrentRegion
    Set rgCopy = rg.Offset(1, 0).Resize(rg.Rows.Count - 1, rg.Columns.Count)
    iCol = .Range("O:O").Column - rg.Column + 1
    rg.AutoFilter
    rg.AutoFilter Field:=iCol, Criteria1:="FX"
    rgCopy.Copy
    With Worksheets.Add(After:=Worksheets(Worksheets.Count))       'Destination worksheet
        .Cells(1, 1).PasteSpecial xlPasteValues
        Cells(1, 1).Select
        .Name = "FX"
    End With
    rg.AutoFilter
    'Auto Sum test
    AutoSum
End With
End Sub
Sub AutoSum()
     
    For Each NumRange In Columns("A").SpecialCells(xlConstants, xlNumbers).Areas
        SumAddr = NumRange.Address(False, False)
        NumRange.Offset(NumRange.Count, 0).Resize(1, 1).Formula = "=SUM(" & SumAddr & ")"
        c = NumRange.Count
    Next NumRange
     
NoData:   
End Sub

Open in new window


Thanks!
eastsidemarketAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
Hi,

You could define names and then read them

Sub AutoSum()
     
    For Each NumRange In Columns("A").SpecialCells(xlConstants, xlNumbers).Areas
        SumAddr = NumRange.Address(False, False)
        NumRange.Offset(NumRange.Count, 0).Resize(1, 1).Formula = "=SUM(" & SumAddr & ")"
        strSheetName = ActiveSheet.Name
        ActiveWorkbook.Names.Add Name:=strSheetName & "_AutoSum", RefersToR1C1:=NumRange.Offset(NumRange.Count, 0).Resize(1, 1).Address
        c = NumRange.Count
    Next NumRange
     
NoData:
End Sub

Open in new window

Regards
0
eastsidemarketAuthor Commented:
how can i call them , copy and paste into a new sheet (including the sheet name) ?

i.e.
i want to paste in the new sheet called "Asset"

column a:
sheet name copied over

column b:
autosum copied over

should be a total


thanks.
0
Rgonzo1971Commented:
Hi,

I've modified the first code Values instead of Address

Sub AutoSum()
     
    For Each NumRange In Columns("A").SpecialCells(xlConstants, xlNumbers).Areas
        SumAddr = NumRange.Address(False, False)
        NumRange.Offset(NumRange.Count, 0).Resize(1, 1).Formula = "=SUM(" & SumAddr & ")"
        strSheetName = ActiveSheet.Name
        ActiveWorkbook.Names.Add Name:=strSheetName & "_AutoSum", RefersToR1C1:=NumRange.Offset(NumRange.Count, 0).Resize(1, 1).Value
        c = NumRange.Count
    Next NumRange
     a = CLng(1)
NoData:
End Sub
Sub PlaceNames()
Counter = 0
For Each wbkName In ActiveWorkbook.Names
    If wbkName.Name Like "*_AutoSum" Then
        Worksheets("Asset").Range("A" & 2 + Counter).Value = Split(wbkName.Name, "_")(0)
        Worksheets("Asset").Range("B" & 2 + Counter).Formula = "=" & wbkName.Name
        Counter = Counter +1
    End If
    
Next
End Sub

Open in new window

EDIT Counter +1 added
0
CompTIA Security+

Learn the essential functions of CompTIA Security+, which establishes the core knowledge required of any cybersecurity role and leads professionals into intermediate-level cybersecurity jobs.

eastsidemarketAuthor Commented:
Appreciate the reply.

I tried this, but still not creating the sheet Asset.
0
FaustulusCommented:
I studied your code and simplified it. Since your two procedures are almost identical they can combined into one.
Option Explicit

Sub Main()                  ' Run is a reserved word used by VBA

    Dim Ws As Worksheet
    
    Set Ws = Worksheets("Filtered from Results")
    CreateNewSheet "EQ", Ws
    CreateNewSheet "FX", Ws
End Sub

Sub CreateNewSheet(ByVal Flt As String, _
                   Ws As Worksheet)
    ' Create new sheet and paste total from filter 'Flt"
    
    Dim NewWs As Worksheet
    Dim CurrWs As Worksheet
    Dim Rg As Range
    Dim Col As Long
    
    Application.ScreenUpdating = False
    Set CurrWs = ActiveSheet
    Set NewWs = Worksheets.Add(After:=Worksheets(Worksheets.Count))     'Destination worksheet

    Set Rg = Ws.Range("O1").CurrentRegion
    With Rg
        Col = Ws.Range("O:O").Column - .Column + 1
        .AutoFilter
        .AutoFilter Field:=Col, Criteria1:=Flt
        .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Copy
    End With
    
    With NewWs
        .Cells(1, 1).PasteSpecial xlPasteValues
        .Name = Flt
    End With
    Rg.AutoFilter

    On Error Resume Next
    CurrWs.Activate
    Application.ScreenUpdating = True
End Sub

Open in new window

I have a problem understanding your AutoSum procedure, however. It writes formulas like =SUM(A1) which will not, as you can see, create any total. Also it isn't clear where this formula is supposed to go, in sheet "Filtered from Results" or the new sheet. The best way, rather than showing code, tell us what you want. I imagine that you would like to draw a total in the new sheet and write that total at the bottom of the column in which it was drawn. For such a scenario I would need to know the column and the first row to start summing from (and the worksheet). It would be easy to add it to the existing code. In fact, a copy of your workbook would be helpful.

I also have a problem with writing the name of the filter (EQ or FX) to cell A1 in the new sheet. Not because it couldn't be done easily enough but because the result of the filter action is written into that same cell. Writing to A1 subsequently must over-write whatever was there before. Perhaps it is something you don't need. In that case I can add it to the code.

Is it conceivable that a worksheet by the name of EQ or FX already exists? If so, an error will result both from your code and my simplification of it. You might specify what you would like to be done in that case. For example, you could delete the old sheet and create a new one. Or you could use the new one and over-write, or you could break off the action.
0
FaustulusCommented:
Is the sheet "Assets" a third sheet you wish to create in addition to the two sheets EQ and FX? It isn't clear to me where the totals come from or where they should be written to.
0
eastsidemarketAuthor Commented:
hi sorry for the confusion.

basically RUN mentioned in my original code calls the filtering code. I have a different filter code for each b/c i'm filtering based on different columns.

FilterEQ Worksheets("Filtered from Results")
FilterFX Worksheets("Filtered from Results")
these both call the filterEQ and filterFX by using the data on Filtered Results.

What this does now is take the data in Filtered from Results tab, filters based on EQ, and then takes the entire sheet and pastes it into a new tab: "EQ". The autosum kicks in and autosums column A (in the new EQ sheet) and places the sum at the bottom of the last row in column A.

I do the same procedure above for a few other filtered criterias. filtering the same filtered from results tab, creating new tabs based on that filter, pasting, and summing up.

What I need to do then is take all the sums I've created across all these tabs.. Copy the sum along with the tab name, and paste the values into a NEWLY CREATED (but not yet created) sheet called "Assets".

This sheet will have :
column a:
sheet name copied over

column b:
autosum copied over

B/c then what I will do that with data is create a pie chart.

Sub FilterEQ(ws As Worksheet)
'start filter code
Dim rg As Range, rgCopy As Range
With ws
    Set rg = .Range("O1").CurrentRegion
    Set rgCopy = rg.Offset(1, 0).Resize(rg.Rows.Count - 1, rg.Columns.Count)
    iCol = .Range("O:O").Column - rg.Column + 1
    rg.AutoFilter
    rg.AutoFilter Field:=iCol, Criteria1:="EQ"
    rgCopy.Copy
    With Worksheets.Add(After:=Worksheets(Worksheets.Count))       'Destination worksheet
        .Cells(1, 1).PasteSpecial xlPasteValues
        Cells(1, 1).Select
        .Name = "EQ"
    End With
    rg.AutoFilter
    'Auto Sum test
    AutoSum
End With
End Sub

Open in new window


hope this clears it up. based on that, can you help with the last piece. taking the autosums, tab names and copy the data over from each tab into a new (not yet created) tab?
0
FaustulusCommented:
Yes, that is clear. I will get to it after dinner. Creating all those sheets is going to become a headache, though, if there is no safety net. In absence of different instruction from you I will program to delete existing sheets of identical names and replace them with new ones.
0
eastsidemarketAuthor Commented:
thanks!
0
FaustulusCommented:
Hello eastsidemarket,
Please try the code in the attached workbook. It isn't too much different from your original but it has been streamlined. Let me help you find your way around. This is the previous Sub Run().
Sub Main()

    Const FilterCriteria As String = "EQ,FX"
    
    Dim Ws As Worksheet
    Dim Crits() As String
    Dim i As Integer
    
    Application.ScreenUpdating = False
    Set Ws = Worksheets("Filtered from Results")
    Crits = Split(FilterCriteria, ",")
    For i = 0 To UBound(Crits)
        ExtractFiltered Crits(i), Ws
    Next i
    CreateSummary "Assets", FilterCriteria
    Application.ScreenUpdating = True
End Sub

Open in new window

'Extract Filtered' is the equivalent of your 'FilterEQ' and 'FilterFX'. Since these two are identical except for a single, lone variable I have thrown them together and call them in a loop, each time feeding a different variable. The variables are in the Const FilterCriteria. You can add as many such criteria as you wish, and adding them to the Const automatically includes them in the loop. Separate them with commas, no spaces.
The main difference between your 'FilterEQ' etc and the new 'ExtractFiltered' is in this line,
WriteColumnTotal 1, NewWs
which calls this procedure which replaces your 'AutoSum',
Private Sub WriteColumnTotal(ByVal Col As Long, _
                             Ws As Worksheet)
    Dim Rl As Long
    
    Rl = LastRow(Col, Ws)
    With Ws.Columns(Col)
        .Cells(Rl + 1).Value = WorksheetFunction.Sum(Range(.Cells(1), .Cells(Rl)))
    End With
End Sub

Open in new window

I couldn't make 'AutoSum' work for me, but I think it attempts to insert a formula in the worksheet. 'WriteColumnTotal' doesn't write a formula. It writes the total. The same procedure is called multiple times to create a total in different columns on different worksheets.
Once all the new sheets are prepared 'Main' calls 'CreateSummary'. This procedure creates a new sheet whose name you can determine by changing the parameter passed to the sub. This sheet is populated as you described.
Note that all the new sheets, incl. 'Assets' are deleted and newly created every time you run the procedure. If you wish to retain any sheets rename them. Only the sheets specified in Const FilterCriteria and in the 'CreateSummary' call will be deleted.
EXX-130921-Extract-Filtered-Data.xlsm
0
eastsidemarketAuthor Commented:
tried your code in my sheet.

says sub or function not defined:

highlights:
ExtractFiltered in ExtractFiltered Crits(i), Ws
0
FaustulusCommented:
The code in the post isn't complete code my a long shot, the code in the attached workbook is. Best, drag the entire module into your own project in the VBE's Project Explorer window. If you need to integrate the code with existing code in your workbook make sure that all of my code is within one module.
0
eastsidemarketAuthor Commented:
great thanks. this is good so far.

how can i move the autosum on Assets to another cell.

let's say G:5 with "Total: autosum"

thanks!
0
FaustulusCommented:
I have re-designed the procedure 'WriteColumnTotal'. Replace the version you have with this one:
Private Sub WriteColumnTotal(ByVal Col As Long, _
                             Ws As Worksheet, _
                             Optional ByVal Vn As String)
    Dim Rl As Long
    Dim Target As Range
    
    Rl = LastRow(Col, Ws)
    If Len(Vn) = 0 Then Vn = Cells(Rl + 1, Col).Address
    With Ws
        .Range(Vn).Value = WorksheetFunction.Sum(Range( _
                           .Cells(1, Col), .Cells(Rl, Col)))
    End With
End Sub

Open in new window

The new version takes one extra, optional argument. If it isn't supplied the total will be written in the cell at the end of the summed column, else it will be written in the cell specified by the argument. Since all calls of this procedure require the total to be written at the default location you don't need to change anything in the existing code except for the one occasion where you would like to redirect the display to another cell, for example G5. That would be in the last line of code in the procedure 'CreateSummary' which should now look like this:-
WriteColumnTotal 2, WsA, "G5"

Open in new window

You can see all of this in action in the attached workbook.
EXX-130922-Extract-Filtered-Data.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
eastsidemarketAuthor Commented:
perfect!! thanks so much! great to deal with, very knowledgeable. !
0
eastsidemarketAuthor Commented:
sorry to bother again, can you advise how i can get these new sheets that are created to auto fit please? having a hard time with this.. thanks!
0
FaustulusCommented:
Thanks for the points!
Add one line of code to the procedure 'ExtractFiltered'.
    NewWs.Cells(1, 1).PasteSpecial xlPasteValues
    WriteColumnTotal 1, NewWs
    NewWs.Columns.AutoFit
    Rg.AutoFilter

Open in new window

The new line is
NewWs.Columns.AutoFit

Open in new window

NewWs.Columns.AutoFit
0
eastsidemarketAuthor Commented:
that worked thanks! I was trying to format the column B to number with no decimals and a comma, but wouldn't work.

any ideas?

I tried:
NewWs.NumberFormat = "#,##0"
0
eastsidemarketAuthor Commented:
can you post the autofit solution in this thread i started? I will award you the points since you resolved it:

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28245081.html
0
FaustulusCommented:
Hi,
I didn't follow that thread and some other experts have put a lot of effort into it. So, I would rather not join at this time. Thank you for the offer, though.
Faustulus
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.