Ramadan
Board Regular
- Joined
- Jan 20, 2024
- Messages
- 136
- Office Version
- 2021
- Platform
- Windows
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
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
Thank you in advance
VBA 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
VBA Code:
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