MrExcel Publishing
Your One Stop for Excel Tips & Solutions

I need to add an additional item to filter code?


Posted by Joe Was on June 14, 2001 9:01 AM

The problem is in the last full module! The rest of the code works well, only the SUM (SumIf), returns wrong or missing values.

I am not certain that SumIf is the right way to sum in this case or if I should re-run the filter?

The code is commented, and works this way; A random list of names is filtered to give a unique list of names on a different sheet. The filtered list is sorted. The number of times each name appears on the original sheet is indicated next to the name on the sorted list.

The problem is; The random list also contains values, which must be totaled next to the count on the sorted list. The code runs and makes the sorted list and count but fails to sum the values? (Only the first Sum row is right, the other sum rows are wrong or missing?)
I think the problem may be in the "Criteria" for the "SumIf?"
Any help will be appreciated!

Sub Find_Names()
'Finds all the unique names, count the number of times each name is listed and give the total value of each name.
'Data is on Sheet2: Names(G), Values(I), Results are listed on Sheet3: Names(H), Count(I) & Values(J).
Application.ScreenUpdating = False

'Find unique names on Sheet2(G), col(7) & list on Sheet3(H).
With Intersect(Columns(7), ActiveSheet.UsedRange)
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Sheet3").Range("H1")
ActiveSheet.ShowAllData
End With

'Sort unique names on sheet3(H).
Sheets("Sheet3").Select
Columns(8).Sort Key1:=Range("H1")

'Count occurrences of names on Sheet2(G), col(7).
'List the number of times each unique name occurred on Sheet2(G), next to the list on sheet3(I).
With Worksheets("Sheet3")
.Range("I1").Formula = "=CountIf(Sheet2!" & Intersect(Sheet2.Columns(7), Sheet2.UsedRange).Address & ",H1)"
.Range("I1:I" & .Range("H1").End(xlDown).Row).FillDown
End With

'Sum values by name on sheet2(I).
'List the sum of values for each unique name occurred on Sheet2: Name(G), Value(I),
'on sheet3: Name(H) & Value(J).
With Worksheets("Sheet3")
.Range("J1").Formula = "=SumIf(Sheet2!" & Intersect(Sheet2.Columns(7), Sheet2.UsedRange).Address & ",H1,Sheet2!I1)"
.Range("J1:J" & .Range("H1").End(xlDown).Row).FillDown
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub



Posted by cpod on June 14, 2001 12:40 PM

You didn't include the full range to sum in the formula that you are copying down. I also changed the sort because it was sorting on Sheet2 instead of Sheet3:

'Finds all the unique names, count the number of times each name is listed and give the total value of each name.
'Data is on Sheet2: Names(G), Values(I), Results are listed on Sheet3: Names(H), Count(I) & Values(J).
Application.ScreenUpdating = False

'Find unique names on Sheet2(G), col(7) & list on Sheet3(H).
With Intersect(ActiveSheet.Columns(7), ActiveSheet.UsedRange)
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Sheet3").Range("H1")
ActiveSheet.ShowAllData
End With

'Sort unique names on sheet3(H).
Sheets("Sheet3").Select
Worksheets("sheet3").Range("h2").Sort Key1:=Worksheets("sheet3").Range("H2")

'Count occurrences of names on Sheet2(G), col(7).
'List the number of times each unique name occurred on Sheet2(G), next to the list on sheet3(I).
With Worksheets("Sheet3")
.Range("I1").Formula = "=CountIf(Sheet2!" & Intersect(Sheet2.Columns(7), Sheet2.UsedRange).Address & ",H1)"
.Range("I1:I" & .Range("H1").End(xlDown).Row).FillDown
test = Worksheets("Sheet3").Range("H1").End(xlDown).Row
End With

'Sum values by name on sheet2(I).
'List the sum of values for each unique name occurred on Sheet2: Name(G), Value(I),
'on sheet3: Name(H) & Value(J).
With Worksheets("Sheet3")
.Range("J1").Formula = "=SumIf(Sheet2!" & Intersect(Sheet2.Columns(7), Sheet2.UsedRange).Address & ",H1,Sheet2!I$1:i$" & Worksheets("Sheet3").Range("H1").End(xlDown).Row & ")"
.Range("J1:J" & .Range("H1").End(xlDown).Row).FillDown
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True

Posted by Joe Was on June 15, 2001 4:30 PM

Thanks, Had to make a small change.

Thanks, Cpod.

The sort had to be the way it was for some reason and the references in the last needed to be changed. Once changed it worked. Thanks again. JSW