PDA

View Full Version : Sum a range with values & blanks then paste product into a cell



MerseaPete
02-01-2013, 08:27 AM
IThis excellent code almost solves my problem, but I want to take the numeric result displayed in the msgbox and past it (Ctrl/v) into a cell
Please help, its driving me nuts.
Thanks

Sub xlSumHiLited()
'
'************************************************************************** **************
' Target Application: MS Excel
' Function: sums all values in a selected range and displays:
' # of cells evaluated
' # of cells that were blank
' # of "bad" cells that were bypassed + content of those cells
' actual sum
'************************************************************************** **************
'
Dim Num As Integer, NumBad As Integer, NumBlank As Integer
Dim Cell As Range
Dim Total As Single
Dim strBuffer As String

Total = 0
Num = 0
NumBad = 0
NumBlank = 0
For Each Cell In Selection
On Error Resume Next
If Cell.Value <> "" Then
Total = Total + Cell.Value
Select Case Err
Case Is = 0
Num = Num + 1
Case Is <> 0
NumBad = NumBad + 1
strBuffer = strBuffer & " " & Cell.Value & vbCrLf
End Select
Else
NumBlank = NumBlank + 1
End If
Next Cell
Select Case NumBad
Case Is = 0
MsgBox "xlSumHiLited" & vbCrLf & vbCrLf & _
"# cells examined = " & (Num + NumBad + NumBlank) & vbCrLf & _
"# blank cells = " & NumBlank & vbCrLf & _
"# cells actually summed = " & Num & vbCrLf & vbCrLf & _
"SUMMED TOTAL = " & Total, vbInformation
Case Is > 0
MsgBox "xlSumHiLited" & vbCrLf & vbCrLf & _
"# cells examined = " & (Num + NumBad + NumBlank) & vbCrLf & _
"# blank cells = " & NumBlank & vbCrLf & _
"# cells actually summed = " & Num & vbCrLf & vbCrLf & _
"SUMMED TOTAL = " & Total & vbCrLf & vbCrLf & _
"# cells bypassed = " & NumBad & vbCrLf & _
"contents of bypassed cells:" & vbCrLf & _
strBuffer, vbInformation
End Select
End Sub

CodeNinja
02-01-2013, 02:32 PM
Why not replace the following lines:
MsgBox "xlSumHiLited" & vbCrLf & vbCrLf & _
"# cells examined = " & (Num + NumBad + NumBlank) & vbCrLf & _
"# blank cells = " & NumBlank & vbCrLf & _
"# cells actually summed = " & Num & vbCrLf & vbCrLf & _
"SUMMED TOTAL = " & Total & vbCrLf & vbCrLf & _
"# cells bypassed = " & NumBad & vbCrLf & _
"contents of bypassed cells:" & vbCrLf & _
strBuffer, vbInformation

with:

sheets(***whatever sheet you want ***).cells(whatever cell address you want) = Total

???

snb
02-01-2013, 02:51 PM
This probably suffices:


Sub M_snb()
On Error Resume Next
y = 0
Z = 0
x = Selection.Cells.Count
y = Selection.SpecialCells(4).Count
Z = Application.Sum(Selection.SpecialCells(2, 1))

MsgBox "number of cells :" & x & vbLf & "number of blanks: " & y & vbLf & "sum of numbers: " & Z
End Sub

MerseaPete
02-01-2013, 04:22 PM
Sub M_snb()
On Error Resume Next
y = 0
Z = 0
x = Selection.Cells.Count
y = Selection.SpecialCells(4).Count
Z = Application.Sum(Selection.SpecialCells(2, 1))

MsgBox "number of cells :" & x & vbLf & "number of blanks: " & y & vbLf & "sum of numbers: " & Z
End Sub

How do I grab & Z and paste it into sheet1 cell A1?
do I need to declare Z as Public??

Thanks

snb
02-02-2013, 04:10 AM
no need for any declaration:
and remove 'option explicit'

Sub M_snb()
On Error Resume Next
y = 0
Z = 0
x = Selection.Cells.Count
y = Selection.SpecialCells(4).Count
Z = Application.Sum(Selection.SpecialCells(2, 1))

MsgBox "number of cells :" & x & vbLf & "number of blanks: " & y & vbLf & "sum of numbers: " & Z
sheets("sheet1").range(A1")=z
End Sub

MerseaPete
02-02-2013, 11:27 AM
Many thanks it was the syntax:

sheets("sheet1").range("A1")=z

That had me tearing my hair especially ***. range("A1")**
I had been omitting " "
Thanks again

snb
02-02-2013, 12:32 PM
No quotationmarks necessary:


Sheets("sheet1").cells(1,1)=z

MerseaPete
02-02-2013, 03:50 PM
Thanks again, I live and learn