Initial capital customized

Hi,

I have the need to normalize the text to display a homogeneous
I enclose a possible conversion code that solves the needs.
I apply to use only instructions in Vb6 therefore no formulas.

Entries test

test a/c
primo/secondo
11f
12 Mm
new.test
test per tre
prova da domani
uno.due
f123h
12 MM

to

Expected Result In VB6

Test A/C
Primo/Secondo
11F
12 mm
New.Test
Test per Tre
Prova da Domani
Uno.Due
F123H
12 mm

Thank you in advance

Hi,

I modified the code now work correctly
Now it is full of all my requests
I hope both index
We accept tips

Code:

---

Option Explicit
Option Compare Text

Sub Maiuscole_Iniziali_VB6()
  Dim Ar, t, CicloA As Long
  Dim tx, ty, j, k, Testo As String
  Ar = [B3:B12]
  Dim CodesToSplit As Variant, X, s, Txt, H
  Dim CodesToReplace As String
  CodesToSplit = Array(".", "/")
  CodesToReplace = "di_da_con_per_mm_in_a_e"
  For CicloA = 1 To UBound(Ar)
    s = Ar(CicloA, 1)
    s = Split(s, " ")
    H = ""
    For Each t In s
      If Len(GetDigits(t & 0)) = 1 Then
        H = H & StrConv(t, vbProperCase) & " "
      Else
        H = H & UCase(t) & " "
      End If
    Next
    s = H
   
    H = ""
    For X = LBound(CodesToSplit) To UBound(CodesToSplit)
      If InStr(s, CodesToSplit(X)) Then
        Txt = Split(s, CodesToSplit(X))
        H = ""
        For Each t In Txt
          H = H & StrConv(t, vbProperCase) & CodesToSplit(X)
        Next
        H = Left(H, Len(H) - 1)
      End If
    Next
    If H = "" Then H = s
    Txt = Split(CodesToReplace, "_")
    For Each s In Txt
      H = Replace(H, " " & s & " ", " " & LCase(s) & " ")
    Next
    MsgBox H
  Next
End Sub

'http://www.excelfox.com/forum/f2/extract-numeric-value-from-alphanumeric-text-using-vba-regexp-853/

Function GetDigits(strAlNum As String) As Variant
  Dim X As Long
  For X = 1 To Len(strAlNum)
    If Mid(strAlNum, X, 1) Like "#" Then GetDigits = GetDigits & Mid(strAlNum, X, 1)
  Next
End Function

---

Somewhat simpler:

Code:

---

Sub M_snb()
  sn = [index(proper(B3:B12),)]
 
  For j = 1 To UBound(sn)
    If InStr(sn(j, 1), " ") Then
        If InStr(Split(sn(j, 1))(1), "/") = 0 Then sn(j, 1) = Replace(sn(j, 1), Split(sn(j, 1))(1), LCase(Split(sn(j, 1))(1)))
    End If
  Next
  [I3:I12] = sn
End Sub

---

Hi,

With the data that I had attached they were not highlighted all combinations.
Thanks to the suggestions of snb I completed the code

Code:

---

Option Explicit
Option Compare Text

Sub M_snb()
  Dim sn, Txt, k
  Dim CodesToReplace As String, s As String
  Dim J As Long
  sn = [index(proper(B3:B12),)]
  CodesToReplace = "di da con per mm in a e la le"
  Txt = Split(CodesToReplace, " ")
  s = Space(1)
  For J = 1 To UBound(sn)
    If InStr(sn(J, 1), " ") Then
      For Each k In Txt
        sn(J, 1) = Replace(sn(J, 1) & s, s & k & s, s & LCase(k) & s)
      Next
    End If
  Next
  [I3:I12] = sn
End Sub

---

Hi,

Unfortunately I could not use the statement: proper Not available in Vb6

So I retrieved the function here
VB Helper: HowTo: Convert text into proper case, version 2

Now everything is OK

I used the Excel formula 'Proper', that is not part of VBA. Check Excel for the meaning of [ ] .
In VBA you can use strconv() instead.

Hi,

Quote:

---

I used the Excel formula 'Proper', that is not part of VBA. Check Excel for the meaning of [ ] .
In VBA you can use strconv() instead.

---

I tried them all really, but do not show the expected result.

Method strconv It is not sufficient
Check Excel for the meaning of [ ]
Ok, evaluates a formula, I had tried to enter a cycle unnecessarily.

It follows the cycle vb6 I have implemented

Code:

---

                For Each celle In dataArray
                    If InStr(celle, Trim(Form1.List1.List(I))) Then
                        FFF = Split(celle, Trim(Form1.List1.List(I)))
                        GGG = Split(FFF(1), "(")
                        HCodes = Replace(Left(GGG(0), Len(GGG(0)) - 1), "-", "")
                        tx = "  " & StrConv(Trim(HCodes), vbLowerCase)
                        tx = "  " & LwrToUpprCase(tx)
                        If InStr(tx, " ") Then
                        For Each K In Testo
                          tx = Replace(tx & s, s & K & s, s & LCase(K) & s)
                        Next
                        End If
                        List8.List(I) = tx
                        arr5(I) = tx
                        Exit For
                    End If
                Next

---

strconv() is your friend:

Code:

---

Sub M_snb()
  sn = [B3:B12]
 
  For j = 1 To UBound(sn)
    sn(j, 1) = Replace(Replace(StrConv(Replace(Replace(sn(j, 1), ".", ". "), "/", "/ "), 3), ". ", "."), "/ ", "/")
    If sn(j, 1) Like "*[0-9]*" Then sn(j, 1) = UCase(sn(j, 1))
   
    For Each it In Split("di da con per mm in a e la le")
      If InStr(1, sn(j, 1) & " ", " " & it & " ", 1) Then sn(j, 1) = Replace(Replace(sn(j, 1), UCase(it), it), StrConv(it, 3), it)
    Next
  Next
 
  [K3:K12] = sn
End Sub

---

Hi,

Modified code, already tested with Vb6 :)
All required steps have been included


Version to be tested in Excel

Code:

---

Sub Gian()
  sn = [B3:B12]
  For J = 1 To UBound(sn)
    sn(J, 1) = Replace(Replace(StrConv(Replace(Replace(sn(J, 1), ".", ". "), "/", "/ "), 3), ". ", "."), "/ ", "/")
    If sn(J, 1) Like "*[0-9]*" Then
        For Each V In Split(sn(J, 1), " ")
          If V Like "*[0-9]*" Then sn(J, 1) = Replace(sn(J, 1), V, UCase(V))
        Next
    End If
    For Each it In Split("di da con per mm in a e la le")
      If InStr(1, sn(J, 1) & " ", " " & it & " ", 1) Then sn(J, 1) = Replace(Replace(sn(J, 1), UCase(it), it), StrConv(it, 3), it)
    Next
  Next
  [K3:K12] = sn
End Sub

---

The modification in unnecessary. My original -simpler- code gets the same result.