H
hshayh0rn
I have a sheet that in column D I will be entering a value of "p" or "f". I
would like code behind the scenes checking column D for a "p" or "f" as well
as "P" or "F" and changing that "p" or "f" to "Pass" or "Fail". Now I also
have some on change code already looking at that cell so I need this code to
append to that code. Here is the code I already have:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim myR As Long
If Target.Cells.Count > 1 Then Exit Sub
If Target.Column <> 4 Then Exit Sub
If UCase(Target.Value) <> "FAIL" Then Exit Sub
Application.EnableEvents = False
myR = Sheets("Notes").Cells(Rows.Count, 4).End(xlUp).Row
Target.EntireRow.Copy Sheets("Notes").Cells(myR + 1, 1).EntireRow
If Target.EntireRow.Cells(1, 1).Value = "" Then
Worksheets("Notes").Range("A" & myR + 1).Value = _
Target.EntireRow.Cells(1, 1).End(xlUp).Value
Else
Worksheets("Notes").Range("A" & myR + 1).Value = _
Target.EntireRow.Cells(1, 1).Value
End If
Sheets("Notes").Cells(myR + 1, 1).Resize(1, 7).Interior.ColorIndex _
= Target.Interior.ColorIndex
Sheets("Notes").Cells(myR + 1, 1).Resize(1, 8).Interior.ColorIndex _
= Target.Interior.ColorIndex
Sheets("Notes").Cells(myR + 1, 7).BorderAround xlContinuous, xlThin
Sheets("Notes").Cells(myR + 1, 8).BorderAround xlContinuous, xlThin
Adden = "Notes!H" & myR
ActiveSheet.Hyperlinks.Add Anchor:=Target, _
Address:="", SubAddress:=Adden, _
TextToDisplay:="Fail"
Application.EnableEvents = True
End Sub
would like code behind the scenes checking column D for a "p" or "f" as well
as "P" or "F" and changing that "p" or "f" to "Pass" or "Fail". Now I also
have some on change code already looking at that cell so I need this code to
append to that code. Here is the code I already have:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim myR As Long
If Target.Cells.Count > 1 Then Exit Sub
If Target.Column <> 4 Then Exit Sub
If UCase(Target.Value) <> "FAIL" Then Exit Sub
Application.EnableEvents = False
myR = Sheets("Notes").Cells(Rows.Count, 4).End(xlUp).Row
Target.EntireRow.Copy Sheets("Notes").Cells(myR + 1, 1).EntireRow
If Target.EntireRow.Cells(1, 1).Value = "" Then
Worksheets("Notes").Range("A" & myR + 1).Value = _
Target.EntireRow.Cells(1, 1).End(xlUp).Value
Else
Worksheets("Notes").Range("A" & myR + 1).Value = _
Target.EntireRow.Cells(1, 1).Value
End If
Sheets("Notes").Cells(myR + 1, 1).Resize(1, 7).Interior.ColorIndex _
= Target.Interior.ColorIndex
Sheets("Notes").Cells(myR + 1, 1).Resize(1, 8).Interior.ColorIndex _
= Target.Interior.ColorIndex
Sheets("Notes").Cells(myR + 1, 7).BorderAround xlContinuous, xlThin
Sheets("Notes").Cells(myR + 1, 8).BorderAround xlContinuous, xlThin
Adden = "Notes!H" & myR
ActiveSheet.Hyperlinks.Add Anchor:=Target, _
Address:="", SubAddress:=Adden, _
TextToDisplay:="Fail"
Application.EnableEvents = True
End Sub