Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Hi Looking for some code that tim 1

Status
Not open for further replies.

Palmcrest

Technical User
Jul 10, 2006
66
AU
Hi
Looking for some code that timestamps for me.
When Percentage in column H = 100 percent
then Column G corresponding rows will show timestamps when 100% was achieved.

I want this to be static and not recalculate when the workbook is opened a day or two later

Cheers
 
Hi,

How does the percent complete get entered in column H?

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Thanks for Responding Skip,
Column H is looking at another sheet and adding up progress from various cells, eventually all tasks will be complete and 100% will be achieved.
 
“Looking”

A formula?

This is going to be an event driven solution. And it seems that the events are located on some other sheet named ???????

You’ve got to give me some very specific info. The formula would help. The workbook would help.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Here are the things I did to your workbook:

1) Named the ranges in Sheet1 & Sheet2 based on column headings

2) Changed your formula for readability and maintainability...
[tt]
G5: =COUNTIFS(Completed,"Y",Category,C5)/COUNTIF(Category,C5)
[/tt]

3) Event code in Sheet2 Code sheet (Right-Click Sheet2 tab/select View Code)...
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'SkipVought 29-01-2018
'change in Completed, calculates the range offset in table in Sheet1
' and puts Date in Time_Stamp if none exists

    Dim sCat As String      'Category value of Completed
    Dim iOff As Integer     'row offset in table on Sheet1
    
    
    If Not Intersect(Target, [Completed]) Is Nothing Then       'value changed in Completed
        sCat = Intersect(Target.EntireRow, [Category]).Value    'corresponding Category value
        
        iOff = Application.Match(sCat, [Cat_Value], 0)          'row offset Sheet1 table
        
        With Sheet1
            If .Range("Actual_Percentage")(iOff).Value = 1 Then   'if 100%
                If .Range("Time_Stamp")(iOff).Value = 0 Then      'if no Time_Stamp
                     .Range("Time_Stamp")(iOff).Value = Date      'then put Date in Time_stamp
                End If
            End If
        End With
    End If
End Sub

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
 http://files.engineering.com/getfile.aspx?folder=259c8095-3826-498e-abe2-ca8e72cbdc8f&file=Example_timestamp.xlsm
Thanks Skip
I will go through this and see what I can learn... I will update this thread after I have a look.
Appreciate your inputs
 
When I update the category column with a "y" I can see the percentage hit 100
But no timestamp is triggered.I have also refreshed data but nothing so far.
 
Did you enable macros when you opened your workbook?

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Yes Macros are enabled.
I restated my laptop and when I add or remove "y"s from the category I get a type mismatch error on this line.
sCat = Intersect(Target.EntireRow, [Category]).Value 'corresponding Category value


EDIT,
Single entry works , if I drag down multiple "y"s I get the error message or delete multiple "y"s
 
Are you using my workbook?

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
When I enter a “y” in Completed, the percent changes on Sheet1 and when the percentage reaches 100%, the Date is placed in the time stamp column.

So I cannot understand what’s happening down under.

Can you right-click the Sheet2 tab and select View Code. Then put a BREAK on the If Not Intersect statement.

Then put a “y” in Completed, and report what happens.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Hi
The line of code turns yellow when I put a break on it and enter a y
To be fair the process works well on one entry at a time. it only has an error if I delete multiple "y"s or drag a y down the list.
 
Thanks for the feedback. I [highlight #FCE94F]modified[/highlight] the code to accommodate multiple cell changes.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'SkipVought 29-01-2018
'change in Completed, calculates the range offset in table in Sheet1
' and puts Date in Time_Stamp if none exists
[highlight #FCE94F]'30-01-2018 accomodated Target of multiple cells[/highlight]

    Dim sCat As String      'Category value of Completed
    Dim iOff As Integer     'row offset in table on Sheet1
   [highlight #FCE94F] Dim t As Range
    
    For Each t In Target[/highlight]
        If Not Intersect([highlight #FCE94F]t[/highlight], [Completed]) Is Nothing Then       'value changed in Completed
            sCat = Intersect([highlight #FCE94F]t[/highlight].EntireRow, [Category]).Value    'corresponding Category value
            
            iOff = Application.Match(sCat, [Cat_Value], 0)          'row offset Sheet1 table
            
            With Sheet1
                If .Range("Actual_Percentage")(iOff).Value = 1 Then   'if 100%
                    If .Range("Time_Stamp")(iOff).Value = 0 Then      'if no Time_Stamp
                         .Range("Time_Stamp")(iOff).Value = Date      'then put Date in Time_stamp
                    End If
                End If
            End With
        End If
    [highlight #FCE94F]Next[/highlight]
End Sub

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
 http://files.engineering.com/getfile.aspx?folder=e0627073-908d-477e-9eb5-f2f3b241ee8a&file=Example_timestamp.xlsm
Thanks Skip
Much appreciated, this helps me understand a few things that were a bit blurry to me.
 
Great!

Just occurred to me since you’re deleting data in Completed, that you might want the Time_Stamp to be cleared if all the “y” values are deleted for any Category value. Yes?

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Yes I did have the same thought. If old stamps are left in there, a new update will not overwrite.
So it would be best on >100% it clearts
 
[pre]
On the Change Event:
If 0% Then
Clear Time_Stamp
If 100% Then
Enter Time_Stamp
[/pre]
Yes?

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'SkipVought 29-01-2018
'change in Completed, calculates the range offset in table in Sheet1
' and puts Date in Time_Stamp if none exists
'30-01-2018 accomodated Target of multiple cells
[highlight #FCE94F]'31-01-2018 clears Time_Stamp if percentage is 0%[/highlight]

    Dim sCat As String      'Category value of Completed
    Dim iOff As Integer     'row offset in table on Sheet1
    Dim t As Range
    
    For Each t In Target
        If Not Intersect(t, [Completed]) Is Nothing Then       'value changed in Completed
            sCat = Intersect(t.EntireRow, [Category]).Value    'corresponding Category value
            
            iOff = Application.Match(sCat, [Cat_Value], 0)          'row offset Sheet1 table
            
[highlight #FCE94F]            With Sheet1
                Select Case .Range("Actual_Percentage")(iOff).Value
                    [b]Case 0      'reset Time_Stamp
                        .Range("Time_Stamp")(iOff).ClearContents          'clear Time_stamp[/b]
                    Case 1      'Assign Time_Stame
                        If .Range("Time_Stamp")(iOff).Value = 0 Then      'if no Time_Stamp
                             .Range("Time_Stamp")(iOff).Value = Date      'then put Date in Time_stamp
                        End If
                End Select
            End With
[/highlight]        End If
    Next
End Sub

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top