How to detect dups and/or sum by group?

[feipezi]

Hi,

Is there any way of combining the following two Subs into one? Or it looks messay.

Thanks.

Sub SumByGroup(keyfield As String, datacol As Integer, destcol As Integer)
'keyfield: the field of key, datacol: Offset number, if keyfield is "a" then datacol=2 means data in field "c"
'destcol: Offset number, similar to datacol
Range(keyfield).Activate
While ActiveCell <> ""
x = 0
y = 0
While ActiveCell = ActiveCell.Offset(1)
If ActiveCell = ActiveCell.Offset(1) Then
x = x + 1
y = y + ActiveCell.Offset(, datacol)
End If
ActiveCell.Offset(, destcol) = y
ActiveCell.Offset(1).Activate
Wend
x = x + 1
y = y + ActiveCell.Offset(, datacol)
ActiveCell.Offset(, destcol) = y
ActiveCell.Offset(1).Activate
Wend
End Sub

Sub RetainSum(KeyCol As String, datacol As Integer, destcol As Integer) 'to make percent calc easy
rmax = ActiveSheet.UsedRange.Rows.Count
rmin = 1
Cells(rmax, KeyCol).Activate
While ActiveCell.Row > rmin
x = 0
constx = ActiveCell.Offset(, datacol)
While ActiveCell = ActiveCell.Offset(-1)
If ActiveCell = ActiveCell.Offset(-1) Then
ActiveCell.Offset(, destcol) = constx
x = x + 1
End If
ActiveCell.Offset(-1).Activate
Wend
ActiveCell.Offset(, destcol) = constx
ActiveCell.Offset(-1).Activate
Wend
End Sub

Sub RunBoth()
SumByGroup "a2", 1, 2
RetainSum "a", 2, 3
End Sub

 

[Andrzejek]

You do not have [tt]Option Explicit[/tt], I would guess.

In Sub SumByGroup: x and y are not defined
In Sub RetainSum: rmax, rmin, x, and constx are not defined.

It would be nice to get timely answers to all questions in your thread(s), like in thread707-1821133

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson