View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Lonnie M. Lonnie M. is offline
external usenet poster
 
Posts: 184
Default How to create uniform ranges?

Hi, I haven't tested this but it should get you in the neighborhood:
'################################################# ########
Sub Test100()
Dim CountData&, X&, SumEnd&, C&, Aholder@, Bholder@, Cholder@
CountData = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
'SumEnd represents the row value to place 100 values
SumEnd = CountData + 1
For X = 1 To CountData
'Assuming A2 is the first data cell
If Aholder < 100 Then
Aholder = Aholder + Cells(X + 1, 1)
Bholder = Bholder + Cells(X + 1, 2)
Cholder = Cholder + Cells(X + 1, 3)
C = C + 1
End If
If Aholder = 100 Then
SumEnd = SumEnd + 1
Cells(SumEnd, 1) = Aholder
Cells(SumEnd, 2) = Bholder / C
Cells(SumEnd, 3) = Cholder / C
Aholder = 0
Bholder = 0
Cholder = 0
C = 0
End If
Next X
End Sub
'################################################# ########
HTH--Lonnie M.