Date stamp when cell value changes

[GDunn]

Hi,

I would like to date stamp a range of cells in column H, when the value on the same row in column G is changed to = "Yes". Have created a Worksheet_Change, but am unable to fix the column H change part.

Private Sub Worksheet_Change(ByVal Target As Range)
With Range("G34:G310")
For Each Cell In Range("G34:G" & ActiveCell.SpecialCells(xlCellTypeLastCell).Row)
Select Case Cell.Value
Case Is = "Yes"
Cell("H34:H").Value = Int(Now)
End Select
Next Cell
End With
End Sub

Thanks in advance

 

[GDunn]

Yes, but I have an existing worksheet_change that hides unused rows.
It seems it is conflicting with the This Workbook code?

 

[AlphaFrog]

Yes, but I have an existing worksheet_change that hides unused rows.
It seems it is conflicting with the This Workbook code?

Can you post that code and any other event procedures you may have?

 

[GDunn]

Private Sub CommandButton1_Click()
With Range("C17:C310")
.EntireRow.Hidden = False
For Each cell In Range("C17:C" & ActiveCell.SpecialCells(xlCellTypeLastCell).Row)
Select Case cell.Value
Case Is = ""
cell.EntireRow.Hidden = True
End Select
Next cell
End With
End Sub


Sub Worksheet_Change(ByVal Target As Range)
'Forces text to Proper case for the range
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("G8:G310")) Is Nothing Then
Application.EnableEvents = False
Target = StrConv(Target, vbProperCase)
Application.EnableEvents = True
End If
'Unhides worksheets as per user
If Worksheets("Sheet1").Range("G8") = "Yes" Then
Worksheets("Sheet2").Visible = True
Else: Worksheets("Sheet2").Visible = False
End If
If Worksheets("Sheet1").Range("G9") = "Yes" Then
Worksheets("Sheet3").Visible = True
Else: Worksheets("Sheet3").Visible = False
End If

If Worksheets("Sheet1").Range("G10") = "Yes" Then
Worksheets("Sheet4").Visible = True
Else: Worksheets("Sheet4").Visible = False
End If


'Hide blank rows
With Range("C17:C372")
.EntireRow.Hidden = False
For Each cell In Range("C17:C" & ActiveCell.SpecialCells(xlCellTypeLastCell).Row)
Select Case cell.Value
Case Is = ""
cell.EntireRow.Hidden = True
End Select
Next cell
End With

On Error GoTo 0
End Sub

 

[AlphaFrog]

Try this...

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim cell As Range
    [COLOR="Red"]Application.EnableEvents = False[/COLOR]
    For Each cell In Sheets("Sheet1").Range("H34:H310").SpecialCells(xlCellTypeFormulas)
        If cell.Value <> "" Then cell.Value = cell.Value
    Next cell
    [COLOR="Red"]Application.EnableEvents = True[/COLOR]
End Sub

 

[Dryver14]

Alpha I don't think it will work unless there are cells that need changing,
If specialcells doesn't find anything it falls down

 

[AlphaFrog]

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim cell As Range
    On Error GoTo ReEnable
    Application.EnableEvents = False
    For Each cell In Sheets("Sheet1").Range("H34:H310").SpecialCells(xlCellTypeFormulas)
        If cell.Value <> "" Then cell.Value = cell.Value
    Next cell
ReEnable:
    Application.EnableEvents = True
End Sub

 

[GDunn]

Thanks Alpha, that's great.