VBA Excel: sum values based on unique range

Luis Diaz
Luis Diaz used Ask the Experts™
on
Hello experts,

I have the following flat file attached (Input Sheet).
I am trying to build a vba procedure that covers the following requirements:
1-Check if Output sheet if so delete and create a new blank
2-Transfer the various unique values in column H, J and AI
3-Consolidate the sum values for the various month from AJ to BV split by column AI

I attached dummy file with expected Output sheet.

I think that we can proceed steps by steps, such as copy unique values related to H & J.
For this we can use the following procedure:

Sub CopyRangeUniqueValues(FromWSheet As String, FromRange As String, ToWSheet As String, ToRange As String)
'Sub treats first cell in FromRange as a header label, and will copy it to ToRange even if it is duplicated in the list
Dim celHome As Range, rgDest As Range, rgSource As Range
Dim n As Long
Set celHome = ActiveCell
Set rgDest = Worksheets(ToWSheet).Range(ToRange)
Range(rgDest, rgDest.End(xlDown)).ClearContents

With Worksheets(FromWSheet)
    n = .UsedRange.Row + .UsedRange.Rows.Count - 1
    Set rgSource = .Range(FromRange & n)
End With

rgDest.Worksheet.Activate
rgSource.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rgDest, Unique:=True
Application.GoTo celHome

Open in new window


Concerning the consolidated sum we can also go ahead with a formula reported in macro:

Sub LoopFormula2(strwsName, strColflag, strCol As String, strColName As String, formula As String)

'Call LoopFormula2("ImportCC", "1", "D", "Test", "=clean(sheet1!G2*sheet1!I2)") 'example of formula
    Dim ws As Worksheet
    Set ws = Worksheets(strwsName)
    ws.Activate
     '==>Clear Destination Column
    Range(strCol & ":" & strCol).Clear
    UsedRows = ActiveSheet.UsedRange.Rows.count + ActiveSheet.UsedRange.Rows(1).Row - 1
    If strColflag = 1 Then
        Range(strCol & 1).Value = strColName
    End If
    '==>Clear Destination Column
    RightFormula = Replace(formula, "1048576", UsedRows)
    '==>ApplyFormula
    Range(Cells(2, strCol), Cells(UsedRows, strCol)).formula = RightFormula
    Range(Cells(2, strCol), Cells(UsedRows, strCol)).Value = Range(Cells(2, strCol), Cells(UsedRows, strCol)).Value
End Sub

Open in new window


Thank you in advance for your help.
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
You forgot to upload the file.
Luis DiazIT consultant

Author

Commented:
Sorry. Please find attached file.
Project-Summary.xlsx
Try attached.
Start with the button.
To speed up the calculation, the Input sheet are sorted on ID, Project name and Request Status.
Then the 3 columns are copied as values to Output.
Duplicates removed.
Because of the sort, the Output values are in the sane order as Input, so summing can be done on small ranges for each type (Output row), instead of looking at all 20,000 rows for each sum.
For each type the input values are loaded into an array, the sum done in VBA, and the result transferred to Output.
Finally the Input sheet are sorted back to what it was, don't know it you need that.
You can follow the progress at the Status Bar in the lower left corner.
The process are done in a few seconds.
Project-Summary.xlsm
Learn SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

Luis DiazIT consultant

Author

Commented:
Great! Excellent as always. Is it possible to have a second proposal with just ID and Project Name, exclude Request status?
Concerning the second line of output is it normal that we don't have information in ID, Name and request status?

Thank you again for your help.
Function with 2 criteria added.

The second line of Output is because the last data row on Input 20016, has empty text in all fields.
Select cell A7, press End and then arrow down.
Then the last cell with text in the column is selected, A20016.
It looks empty, but is not.
Press End, and then arrow right, and cell BV20016 is selected, so none of the cells in that range is empty.
Empty text means it is text with no length, but the cells are not empty.

Delete the cells, or the row.
Project-Summary.xlsm
Luis DiazIT consultant

Author

Commented:
Got it. Thank you again for your help! As soon as I can test the second proposal I will keep you informed.
Luis DiazIT consultant

Author

Commented:
I tested and it works. Thank you again!

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