Just because I was bored and wanted to play a bit.
I wrote a somewhat different approach to your macro.
I utilized "Dictionary Objects" for each of the readings and total values you
were collecting.
I initialized the Objects,
then read through the data and added the values to the Dictionary Objects.
Then inserted the totals.
On my machine, your approach took 38 seconds.
This approach ran in .08 seconds.
(watch the editor's line wrapping)
if you're interested...
---------------------------------------------------
Sub Dict_Sum()
Dim Dict_Reading1
Dim Dict_Reading2
Dim Dict_Reading3
Dim Dict_Reading4
Dim Dict_Total
Dim R
Dim tStart, tStop, tMin, tSec
tStart = Timer
Set Dict_Reading1 = CreateObject("Scripting.Dictionary")
Dict_Reading1.RemoveAll
Set Dict_Reading2 = CreateObject("Scripting.Dictionary")
Dict_Reading2.RemoveAll
Set Dict_Reading3 = CreateObject("Scripting.Dictionary")
Dict_Reading3.RemoveAll
Set Dict_Reading4 = CreateObject("Scripting.Dictionary")
Dict_Reading4.RemoveAll
Set Dict_Total = CreateObject("Scripting.Dictionary")
Dict_Total.RemoveAll
'-----------------------------------------------------
'Load Dictionary
'-----------------------------------------------------
For R = 2 To 40
If (Cells(R, "T").Value = "") Then Exit For
Dict_Reading1.Add Cells(R, "T").Value, 0
Dict_Reading2.Add Cells(R, "T").Value, 0
Dict_Reading3.Add Cells(R, "T").Value, 0
Dict_Reading4.Add Cells(R, "T").Value, 0
Dict_Total.Add Cells(R, "T").Value, 0
Next R
'----------------------------------------------------
'Add Data
'----------------------------------------------------
For R = 2 To ActiveCell.SpecialCells(xlLastCell).Row
If (Dict_Reading1.exists(Cells(R, "C").Value)) Then
Dict_Reading1.Item(Cells(R, "C").Value) =
Dict_Reading1.Item(Cells(R, "C").Value) + Cells(R, "D").Value
Dict_Reading2.Item(Cells(R, "C").Value) =
Dict_Reading2.Item(Cells(R, "C").Value) + Cells(R, "E").Value
Dict_Reading3.Item(Cells(R, "C").Value) =
Dict_Reading3.Item(Cells(R, "C").Value) + Cells(R, "F").Value
Dict_Reading4.Item(Cells(R, "C").Value) =
Dict_Reading4.Item(Cells(R, "C").Value) + Cells(R, "G").Value
Dict_Total.Item(Cells(R, "C").Value) = Dict_Total.Item(Cells(R,
"C").Value) + Cells(R, "H").Value
End If
Next R
'----------------------------------------------------
' Paste Totals
'----------------------------------------------------
Application.ScreenUpdating = False
For R = 2 To 40
If (Cells(R, "T").Value = "") Then Exit For
Cells(R, "U").Value = Dict_Reading1.Item(Cells(R, "T").Value)
Cells(R, "V").Value = Dict_Reading2.Item(Cells(R, "T").Value)
Cells(R, "W").Value = Dict_Reading3.Item(Cells(R, "T").Value)
Cells(R, "X").Value = Dict_Reading4.Item(Cells(R, "T").Value)
Cells(R, "Y").Value = Dict_Total.Item(Cells(R, "T").Value)
Next R
Application.ScreenUpdating = True
tStop = Timer
tMin = Int((tStop - tStart) / 60)
tSec = Round((tStop - tStart) - (tMin * 60), 2)
Debug.Print tStop & "-" & tStart & " " & tMin & ": " & tSec
MsgBox tMin & ": " & tSec
End Sub
Paul
-----------------------------------------
“Do all the good you can,
By all the means you can,
In all the ways you can,
In all the places you can,
At all the times you can,
To all the people you can,
As long as ever you can.” - John Wesley
-----------------------------------------
________________________________
From: karunanithi ramaswamy <[email protected]>
To: "[email protected]" <[email protected]>
Sent: Fri, November 2, 2012 1:15:24 PM
Subject: $$Excel-Macros$$ Re$$Excel-macro$$vba for sumif function-type mismatch
error -reg
Dear Expert Paul Schreiner,
"Thank you" for your remarks. After correcting the"spaces" into "0",it
works.
-R.Karunanithi.--
Join official facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES (1120+ members already BANNED for violation)
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Cross-promotion of, or links to, forums competitive to this forum in
signatures are prohibited.
6) Jobs posting is not allowed.
7) Sharing copyrighted ebooks/pirated ebooks/their links is not allowed.
NOTE : Don't ever post personal or confidential data in a workbook. Forum
owners
and members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To post to this group, send email to [email protected].
To unsubscribe from this group, send email to
[email protected].
Visit this group at http://groups.google.com/group/excel-macros?hl=en.
--
Join official facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES (1120+ members already BANNED for violation)
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Cross-promotion of, or links to, forums competitive to this forum in
signatures are prohibited.
6) Jobs posting is not allowed.
7) Sharing copyrighted ebooks/pirated ebooks/their links is not allowed.
NOTE : Don't ever post personal or confidential data in a workbook. Forum
owners and members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To post to this group, send email to [email protected].
To unsubscribe from this group, send email to
[email protected].
Visit this group at http://groups.google.com/group/excel-macros?hl=en.
