oops.. failed to upload...
Here's the detail:
I changed the double-click event to:
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim NewVal
If Not Intersect(Target, Range("D2:D43")) Is Nothing Then
If Not IsError(Application.Match(Target.Offset(0, -3), Sheets("DATA").Range("cashdd"), 0)) Then
Cancel = True
With Target
.Value = .Offset(0, -1).Value
NewVal = Total_Update(ActiveSheet.Cells(Target.Row, "A").Value, ActiveSheet.Cells(Target.Row, "B").Value, Target.Value)
' comment out this line when testing is complete
MsgBox NewVal
End With
End If
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim NewVal
If Not Intersect(Target, Range("D2:D43")) Is Nothing Then
If Not IsError(Application.Match(Target.Offset(0, -3), Sheets("DATA").Range("cashdd"), 0)) Then
Cancel = True
With Target
.Value = .Offset(0, -1).Value
NewVal = Total_Update(ActiveSheet.Cells(Target.Row, "A").Value, ActiveSheet.Cells(Target.Row, "B").Value, Target.Value)
' comment out this line when testing is complete
MsgBox NewVal
End With
End If
End If
End Sub
The "Standard" module looks like:
Option Explicit
Public Dict_Names
Function Total_Update(IDname, tMonth, dValue)
Dim tDate As Date, Mon As Integer, tRow As Integer
' Load Names list into Dictionary Object
If (Not Load_Dict_Names) Then Exit Function
' Convert Month string to Date, then to Month Number
On Error Resume Next
tDate = DateValue(tMonth & "-1-" & Year(Now()))
If (Err.Number <> 0) Then
MsgBox "Month """ & tMonth & """ Not Recognized"
Total_Update = False
Exit Function
End If
Mon = Month(tDate)
' Determine Row on TOTALS sheet
If (Not Dict_Names.exists(IDname)) Then
MsgBox "Name """ & IDname & """ not found on TOTALS sheet"
Total_Update = False
Exit Function
Else
tRow = Dict_Names.Item(IDname)
Sheets("TOTALS").Cells(tRow, Mon + 1).Value = Sheets("TOTALS").Cells(tRow, Mon + 1).Value + dValue
End If
Total_Update = Sheets("TOTALS").Cells(tRow, Mon + 1).Value
End Function
Public Dict_Names
Function Total_Update(IDname, tMonth, dValue)
Dim tDate As Date, Mon As Integer, tRow As Integer
' Load Names list into Dictionary Object
If (Not Load_Dict_Names) Then Exit Function
' Convert Month string to Date, then to Month Number
On Error Resume Next
tDate = DateValue(tMonth & "-1-" & Year(Now()))
If (Err.Number <> 0) Then
MsgBox "Month """ & tMonth & """ Not Recognized"
Total_Update = False
Exit Function
End If
Mon = Month(tDate)
' Determine Row on TOTALS sheet
If (Not Dict_Names.exists(IDname)) Then
MsgBox "Name """ & IDname & """ not found on TOTALS sheet"
Total_Update = False
Exit Function
Else
tRow = Dict_Names.Item(IDname)
Sheets("TOTALS").Cells(tRow, Mon + 1).Value = Sheets("TOTALS").Cells(tRow, Mon + 1).Value + dValue
End If
Total_Update = Sheets("TOTALS").Cells(tRow, Mon + 1).Value
End Function
Function Load_Dict_Names()
Dim IDname, sNames, eNames
Dim nRow
Set Dict_Names = CreateObject("Scripting.Dictionary")
Dict_Names.RemoveAll
sNames = Sheets("TOTALS").Range("Names").Row
eNames = Sheets("TOTALS").Range("Names").Rows.Count
For nRow = sNames To sNames + eNames
IDname = Sheets("TOTALS").Cells(nRow, "A").Value
If (IDname & "X" <> "X") Then
If (Not Dict_Names.exists(IDname)) Then
Dict_Names.Add IDname, nRow
Else
MsgBox "Duplicate name on ""TOTALS"" sheet:" _
& Chr(13) & Chr(13) & IDname _
& Chr(13) & "rows: " & Dict_Names.Item(IDname) & ", " & nRow
Load_Dict_Names = False
Exit Function
End If
End If
Next nRow
Load_Dict_Names = True
Dim IDname, sNames, eNames
Dim nRow
Set Dict_Names = CreateObject("Scripting.Dictionary")
Dict_Names.RemoveAll
sNames = Sheets("TOTALS").Range("Names").Row
eNames = Sheets("TOTALS").Range("Names").Rows.Count
For nRow = sNames To sNames + eNames
IDname = Sheets("TOTALS").Cells(nRow, "A").Value
If (IDname & "X" <> "X") Then
If (Not Dict_Names.exists(IDname)) Then
Dict_Names.Add IDname, nRow
Else
MsgBox "Duplicate name on ""TOTALS"" sheet:" _
& Chr(13) & Chr(13) & IDname _
& Chr(13) & "rows: " & Dict_Names.Item(IDname) & ", " & nRow
Load_Dict_Names = False
Exit Function
End If
End If
Next nRow
Load_Dict_Names = True
End Function
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
-----------------------------------------
"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
-----------------------------------------
__._,_.___
Posted by: Paul Schreiner <schreiner_paul@att.net>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (3) |
Have you tried the highest rated email app?
With 4.5 stars in iTunes, the Yahoo Mail app is the highest rated email app on the market. What are you waiting for? Now you can access all your inboxes (Gmail, Outlook, AOL and more) in one place. Never delete an email again with 1000GB of free cloud storage.
----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.
----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA
----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com
----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.
----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA
----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com
----------------------------------
.
__,_._,___
Tidak ada komentar:
Posting Komentar