Able to copy Able to copy alphabet, but not able to make numeric entry.

[Frncis]

I have a workbook to assist staff in tracking their vacation & sick time. The workbook consists of 2 worksheets. Sheet # 1 is labeled Annual Leave Record, sheet 2 is labeled Sick Leave Record. The listed code is a module that is coded on sheet 1 (provided by Marc L). It does copy the letter H (Holliday), but does not allow any numeric entries on the sheets.

The only thing that sheet 1 & 2 have in common is the letter “H”. The numeric entries can be anything from .25 to 8. The 2 sheets are independent of each other, regarding the numeric entries. Meaning that when an entry is made on 1 sheet, it does not copy to the other.
I have attached a sanitized version of the work book.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 And Not Intersect([D4:Q29], Target) Is Nothing And Not Target.HasFormula Then
            S$ = UCase$(Left$(Target.Value2, 1))
        If S > "" Then
            Application.EnableEvents = False
            If S <> "H" Then Beep: Target.ClearContents Else Target.Value2 = S: Sheet2.Range(Target.Address).Value2 = S
            Application.EnableEvents = True
        End If
    End If
End Sub

 

[Stevie]

Hi Frncis,
I did not see the original post, but from what I understand from this one, the below may help:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.count = 1 And Not Intersect([D4:Q29], Target) Is Nothing And Not Target.HasFormula Then
        If Not IsNumeric(Target.Value2) Then S$ = UCase$(Left$(Target.Value2, 1)): num = False Else S$ = CDbl(Target.Value2): num = True
        Application.EnableEvents = False
        If num Then
            If S < 0.25 Or S > 8 Then Beep: Target.ClearContents Else Target.Value2 = S: Sheet2.Range(Target.address).Value2 = S
        Else:
            If S > "" Then If S <> "H" Then Beep: Target.ClearContents Else Target.Value2 = S: Sheet2.Range(Target.address).Value2 = S
        End If
        Application.EnableEvents = True
    End If
End Sub

I have left the beeps in as I assume they are a requirement.

If this was helpful, please click 'Like!'

Stevie

 

[Frncis]

It does allow numeric entries. However it also copies the entry to sheet 2. The numeric entries can not be copied.

 

[Stevie]

Hi Frncis, are you saying you don't want it to copy numbers across?
This is an incredibly simple change to my code, the bit which copies the numbers is:

Sheet2.Range(Target.address).Value2 = S

If this is not clear, I would highly suggest doing some reading and research into VBA so that you know what it is the code your are using is doing.

Here is the code without the number copy;

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.count = 1 And Not Intersect([D4:Q29], Target) Is Nothing And Not Target.HasFormula Then
        If Not IsNumeric(Target.Value2) Then S$ = UCase$(Left$(Target.Value2, 1)): num = False Else S$ = CDbl(Target.Value2): num = True
        Application.EnableEvents = False
        If num Then
            If S < 0.25 Or S > 8 Then Beep: Target.ClearContents Else Target.Value2 = S: Sheet2.Range(Target.address).Value2 = S
        Else:
            If S > "" Then If S <> "H" Then Beep: Target.ClearContents Else Target.Value2 = S
        End If
        Application.EnableEvents = True
    End If
End Sub

Please click 'Like' on my posts if they were helpful.

Stevie

 

[Frncis]

Thank you. Also for explaining the code, once I had a chance to study the difference. It became very clear.

Here is your code so if others, want to use it.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 And Not Intersect([D4:Q29], Target) Is Nothing And Not Target.HasFormula Then
        If Not IsNumeric(Target.Value2) Then S$ = UCase$(Left$(Target.Value2, 1)): num = False Else S$ = CDbl(Target.Value2): num = True
        Application.EnableEvents = False
        If num Then
            If S < 0.25 Or S > 8 Then Beep: Target.ClearContents Else Target.Value2 = S
        Else:
            If S > "" Then If S <> "H" Then Beep: Target.ClearContents Else Target.Value2 = S
        End If
        Application.EnableEvents = True
    End If
End Sub