My code to capitalize first letter duplicates the letter

[Ramadan]

I was looking for a code to capitalize the first letter in coulmn "F" and I have found one working good but I don't know why it duplicates the first letter and capitaslize it for example if I wrote a word like "good" it changes it to be "Ggood" not just "Good" ..... any suggestiona please ? here is the code

Private Sub Worksheet_Change(ByVal Target As Range)

 Dim z As Long
    Dim xVal As String
    On Error Resume Next
    If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    For z = 1 To Target.Count
    If Target(z).Value > 0 Then
    Target(z).Formula = UCase(Left((Target(z).Value), 1)) & LCase(Mid((Target(z).Value), 1))
    End If
    Next
    Application.EnableEvents = True
    
End Sub

Also in the same sheet I have this below code based on worksheet change and as i know i can't put two codes in the sheet based on worksheet change so if possible please I need to know how to merge them together in one code .. this is the second code I have

Private Sub Worksheet_Change(ByVal Target As Range)

    ' Reference the initial range, the cells to be monitored for a change.
    Dim rg As Range:
    With Me.Range("E10")
        Set rg = .Resize(Me.Rows.Count - .Row + 1) ' i.e. 'E10:E1048576'
    End With
    
    Dim trg As Range: Set trg = Intersect(rg, Target)
    If trg Is Nothing Then Exit Sub ' no target cell was changed

    Dim tcell As Range ' Target Cell
    Dim rcell As Range ' Read Cell to Check for Met Condition(s)
    Dim Value As Variant ' Read Value to Check for Met Condition(s)
    Dim n As Long, StrLen As Long, IsMet As Boolean
    
    On Error GoTo ClearError
    Application.EnableEvents = False
    
    ' Process the changed cells, the cells of the target range.
    For Each tcell In trg.Cells
        
        IsMet = False ' reset
        Set rcell = tcell.EntireRow.Columns("B")
        Value = rcell.Value
        If VarType(Value) = vbDouble Then IsMet = True ' is a number
        ' 2nd Set of Conditions
        If IsMet Then ' 1st condition is met
            IsMet = False ' reset
            Set rcell = tcell.EntireRow.Columns("E")
            Value = rcell.Value
            If Not IsError(Value) Then ' is no error
                StrLen = Len(Value)
                If StrLen > 0 Then ' is not blank
                    If InStr(Value, "@") = 0 Then IsMet = True ' no delim.
                End If
            End If
        End If
        ' Write.
        If IsMet Then ' both conditions are met
            For n = 1 To StrLen
                If AscW(Mid(Value, n, 1)) >= 1000 Then Exit For ' first Arabic
            Next n
            n = n - 1 ' last 'English'
            rcell.Value = Left(Value, n) & "@" & Right(Value, StrLen - n)
        'Else ' both sets of conditions are not met; do nothing
        End If
    Next tcell
        
    ' Consider discarding the following line because it slows down the code.
    'ThisWorkbook.Save

ProcExit:
    Application.EnableEvents = True
    Exit Sub
ClearError: ' continue error-handling routine
    MsgBox "Run-time error ]" & Err.Number & "]:" & vbLf & vbLf _
        & Err.Description, vbCritical
    Resume ProcExit ' redirect error-handling routine
      
      
End Sub

Thank you in advance

 

[HighAndWilder]

I was looking for a code to capitalize the first letter in coulmn "F" and I have found one working good but I don't know why it duplicates the first letter and capitaslize it for example if I wrote a word like "good" it changes it to be "Ggood" not just "Good" ..... any suggestiona please ? here is the code

Private Sub Worksheet_Change(ByVal Target As Range)

 Dim z As Long
    Dim xVal As String
    On Error Resume Next
    If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
   
    Application.EnableEvents = False
    For z = 1 To Target.Count
    If Target(z).Value > 0 Then
    Target(z).Formula = UCase(Left((Target(z).Value), 1)) & LCase(Mid((Target(z).Value), 1))
    End If
    Next
    Application.EnableEvents = True
   
End Sub

Also in the same sheet I have this below code based on worksheet change and as i know i can't put two codes in the sheet based on worksheet change so if possible please I need to know how to merge them together in one code .. this is the second code I have

Private Sub Worksheet_Change(ByVal Target As Range)

    ' Reference the initial range, the cells to be monitored for a change.
    Dim rg As Range:
    With Me.Range("E10")
        Set rg = .Resize(Me.Rows.Count - .Row + 1) ' i.e. 'E10:E1048576'
    End With
   
    Dim trg As Range: Set trg = Intersect(rg, Target)
    If trg Is Nothing Then Exit Sub ' no target cell was changed

    Dim tcell As Range ' Target Cell
    Dim rcell As Range ' Read Cell to Check for Met Condition(s)
    Dim Value As Variant ' Read Value to Check for Met Condition(s)
    Dim n As Long, StrLen As Long, IsMet As Boolean
   
    On Error GoTo ClearError
    Application.EnableEvents = False
   
    ' Process the changed cells, the cells of the target range.
    For Each tcell In trg.Cells
       
        IsMet = False ' reset
        Set rcell = tcell.EntireRow.Columns("B")
        Value = rcell.Value
        If VarType(Value) = vbDouble Then IsMet = True ' is a number
        ' 2nd Set of Conditions
        If IsMet Then ' 1st condition is met
            IsMet = False ' reset
            Set rcell = tcell.EntireRow.Columns("E")
            Value = rcell.Value
            If Not IsError(Value) Then ' is no error
                StrLen = Len(Value)
                If StrLen > 0 Then ' is not blank
                    If InStr(Value, "@") = 0 Then IsMet = True ' no delim.
                End If
            End If
        End If
        ' Write.
        If IsMet Then ' both conditions are met
            For n = 1 To StrLen
                If AscW(Mid(Value, n, 1)) >= 1000 Then Exit For ' first Arabic
            Next n
            n = n - 1 ' last 'English'
            rcell.Value = Left(Value, n) & "@" & Right(Value, StrLen - n)
        'Else ' both sets of conditions are not met; do nothing
        End If
    Next tcell
       
    ' Consider discarding the following line because it slows down the code.
    'ThisWorkbook.Save

ProcExit:
    Application.EnableEvents = True
    Exit Sub
ClearError: ' continue error-handling routine
    MsgBox "Run-time error ]" & Err.Number & "]:" & vbLf & vbLf _
        & Err.Description, vbCritical
    Resume ProcExit ' redirect error-handling routine
     
     
End Sub

Thank you in advance

Try this for the first requirement.

I am not quite sure what you are trying to do in the second requirement but I am sure that it can done in an easier way.

Can you explain what you are trying to do?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim varValue As Variant

On Error GoTo Err_Handler

  ' **** If the first character entered in column F is a-z or A-Z then change this character
  ' **** to uppercase.
  If Not Intersect(Target, Range("F:F")) Is Nothing _
    And Target.Count = 1 _
    And Len(Trim(Target.Value)) > 0 Then

    varValue = Trim(Target.Value)
    
    If Asc(Left(varValue, 1)) > 64 And Asc(Left(varValue, 1)) < 90 Or _
    Asc(Left(varValue, 1)) > 96 And Asc(Left(varValue, 1)) < 123 Then
      
      Application.EnableEvents = False
      Target.Value = UCase(Left(varValue, 1)) & Mid(varValue, 2, Len(varValue) - 1)
      Application.EnableEvents = True
      
    End If
  
  End If
  
Exit_Handler:

  Exit Sub

Err_Handler:

  Resume Exit_Handler
    
End Sub

 

[Macropod]

A trivial change is all that's needed for the first one:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim z As Long, xVal As String
On Error Resume Next
If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
For z = 1 To Target.Count
  If Target(z).Value > 0 Then Target(z).Formula = UCase(Left((Target(z).Value), 1)) & Mid((Target(z).Value), 2)
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[Ramadan]

A trivial change is all that's needed for the first one:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim z As Long, xVal As String
On Error Resume Next
If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
For z = 1 To Target.Count
  If Target(z).Value > 0 Then Target(z).Formula = UCase(Left((Target(z).Value), 1)) & Mid((Target(z).Value), 2)
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Thank you so much @Macropod now it works perfectly
for your info. the second code simply chec the text in "E" and add @ symbol between the English and Arabic Text

 

[Ramadan]

@Macropod to override combining workshet events together whch might affect my important code I have found this code to run it as macro inside of worksheet event but i seems little slow
do you have nay suggestion to speed it up

Option Explicit
Sub ConvertUppercaseInRange()

    Dim wsSrc As Worksheet
    Dim rngCell As Range
    Dim lngLastRow As Long

    Application.ScreenUpdating = False
    
    Set wsSrc = ThisWorkbook.Sheets("Sheet1")
    lngLastRow = wsSrc.Range("f:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
   For Each rngCell In wsSrc.Range("f1:F" & lngLastRow)
        If Len(rngCell) > 0 And IsNumeric(rngCell) = False Then
             rngCell.Value = Replace(StrConv(rngCell.Value, vbProperCase), "Dean Farms", "DEAN FARMS", , , vbBinaryCompare = True)
        End If
    Next rngCell
            
    Application.ScreenUpdating = True
    
End Sub

 

[Ramadan]

Try this for the first requirement.

I am not quite sure what you are trying to do in the second requirement but I am sure that it can done in an easier way.

Can you explain what you are trying to do?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim varValue As Variant

On Error GoTo Err_Handler

  ' **** If the first character entered in column F is a-z or A-Z then change this character
  ' **** to uppercase.
  If Not Intersect(Target, Range("F:F")) Is Nothing _
    And Target.Count = 1 _
    And Len(Trim(Target.Value)) > 0 Then

    varValue = Trim(Target.Value)
  
    If Asc(Left(varValue, 1)) > 64 And Asc(Left(varValue, 1)) < 90 Or _
    Asc(Left(varValue, 1)) > 96 And Asc(Left(varValue, 1)) < 123 Then
    
      Application.EnableEvents = False
      Target.Value = UCase(Left(varValue, 1)) & Mid(varValue, 2, Len(varValue) - 1)
      Application.EnableEvents = True
    
    End If
 
  End If
 
Exit_Handler:

  Exit Sub

Err_Handler:

  Resume Exit_Handler
  
End Sub

@HighAndWilder thank you so much your code works perfectly and faster, my second coce check the text in "E" and add symbol @ between Arabic and English text to use that in other columns with formulas to extract special text from string if there is a way to combine it with your code would be great

 

[HighAndWilder]

@HighAndWilder thank you so much your code works perfectly and faster, my second coce check the text in "E" and add symbol @ between Arabic and English text to use that in other columns with formulas to extract special text from string if there is a way to combine it with your code would be great

Re: check the text in "E" and add symbol @ between Arabic and English text.

Why do you need to do this when there is a worksheet change?

Would it be better to insert the @ symbol when the data is entered and only do a replace catch up on exsiting data once?

Re: to use that in other columns with formulas to extract special text from string if there is a way to combine it with your code would be great.
I'm not sure what you need here. Please explain what you have in terms of data and what you need it to be.

 

[Ramadan]

Re: check the text in "E" and add symbol @ between Arabic and English text.

Why do you need to do this when there is a worksheet change?

Would it be better to insert the @ symbol when the data is entered and only do a replace catch up on exsiting data once?

Re: to use that in other columns with formulas to extract special text from string if there is a way to combine it with your code would be great.
I'm not sure what you need here. Please explain what you have in terms of data and what you need it to

@HighAndWilder I need it to be with worksheet change because I don't add the text in "E" manually but copy and paste from my company online working system and formula in C & D extract text automatically from the string in "E" and once a user add the task in "E" everything in the row adjust automatically after adding this @
I addached screenshot herein after to understand what i mean

 

[HighAndWilder]

@HighAndWilder I need it to be with worksheet change because I don't add the text in "E" manually but copy and paste from my company online working system and formula in C & D extract text automatically from the string in "E" and once a user add the task in "E" everything in the row adjust automatically after adding this @
I addached screenshot herein after to understand what i mean View attachment 122391

I can understand why you would want to use Worksheet_Change but for a one off exercise on the copied range I would keep it quiet seperate.

In rows 1 to 3 there is a date after the @. Should the @ be after the date?

Let me summarise with some questions:

A: You copy and paste the data into a worksheet.
Q1: Is this a new worksheet or do you paste the data onto the bottom of an existing worksheet?
Q2: I assume that you only copy aand paste one column (Permissions)

B: You need to be able to insert a @ where the English text finishes and the Arabic text starts.
Q1: Is this only for the purposes of then being able to ascertain NH and Unit No?
Q2: Would it be useful to remove the English text from Permissions once NH and Unit No have been ascertained?
Q3: If the answerto Q2 is 'yes' then do you need the @ to be there?

 

[Ramadan]

@HighAndWilder thank you for being patient to go summerize these points and I will answer accordingly
A: Q1. Yes on the bottom of the worksheet. the workbook contains 12 sheets one for each month and every sheet is devived to 30 pages or 31 for the month days and I paste the data in the same sheet every day of the month
Q2. Yes i only paste in column "E" permission and write the assgined employee in "F"

B:Q1. Yes this to be able to extract the NH and unit number and these are the formulas that I use in "C" for NH (=LEFT(E759,SEARCH("-",E759)-1) this is simple but the formula for UNIt nO. has alot of issues to handle because that text in "E" is not always has the same combination and may have date ro - or \ etc... and still I might face some exeption but I sove it manually like the date you mentioned
in "E" I use this formula
=IF(RIGHT(TRIM(MID(E759,SEARCH("-",E759)+1,FIND("@",E759)-SEARCH("-",E759)-1)),1)="-",LEFT(TRIM(MID(E759,SEARCH("-",E759)+1,FIND("@",E759)-SEARCH("-",E759)-1)),LEN(TRIM(MID(E759,SEARCH("-",E759)+1,FIND("@",E759)-SEARCH("-",E759)-1)))-1),TRIM(MID(E759,SEARCH("-",E759)+1,FIND("@",E759)-SEARCH("-",E759)-1)))

you can see that I'm now at row #759 in the same sheet

Q2. No I need to keep the same text in Permission as it, so that I can copy it privately for any user to discuss

Q3. actually yes - I spend alot of time till reaching this solution of @ and it works perfectly with me

thank you again for your trying to help me but I see that it might be easier to capitalize the first letter in "F" with a macro button not work a worksheet event no probelm at all for me and will be good and I have found a code and mentioned it above at 12:24 pm to do so but unfortunately it take a long time freezing the excel to run I don't know why while when I test it on a new sheet works smoothly . so if you can suggest an edit to make it faster would be much much appreciated
thanks again @HighAndWilder