Initial capital customized

[PcMax]

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

[PcMax]

Hi,

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


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

[snb]

Somewhat simpler:


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

[PcMax]

Hi,

With the data that I had attached they were not highlighted all combinations.
Thanks to the suggestions of snb I completed the 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

[PcMax]

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 (http://www.vb-helper.com/howto_convert_to_propercase_2.html)

Now everything is OK

[snb]

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.

[PcMax]

Hi,


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


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

[snb]

strconv() is your friend:


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

[PcMax]

Hi,

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


Version to be tested in Excel

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

[snb]

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

[PcMax]

Hi,


The combinations of the items requiring correction, unfortunately I have not managed to solve all situations
I attach the file with new entries

[snb]

Sub M_snb()
sn = [B3:B12]

For j = 1 To UBound(sn)
sn(j, 1) = Replace(Replace(StrConv(Replace(Replace(sn(j, 1), ".", ". "), "/", "/ "), 3), ". ", "."), "/ ", "/")

st = Split(sn(j, 1))
For jj = 0 To UBound(st)
If st(jj) Like "*[0-9]*" Then st(jj) = UCase(st(jj))
Next
sn(j, 1) = Join(st)

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) = Trim(Replace(Replace(sn(j, 1) & " ", " " & UCase(it) & " ", " " & it & " "), " " & StrConv(it, 3) & " ", " " & it & " "))
Next
Next

[G3:G12] = sn
End Sub

[Rick Rothstein]

Here is another macro that you can try...



Sub SpecialProperCase()
Dim R As Long, X As Long, CellVals As Variant, Words() As String
CellVals = Range("B3", Cells(Rows.Count, "B").End(xlUp))
For R = 1 To UBound(CellVals)
Words = Split(Application.Proper(CellVals(R, 1)))
For X = 0 To UBound(Words)
If Words(X) Like "#*" Then
Words(X) = UCase(Words(X))
ElseIf " di da con per mm in a e la le " Like "*[!A-Z0-9]" & LCase(Words(X)) & "[!A-Z0-9]*" Then
Words(X) = LCase(Words(X))
End If
Next
CellVals(R, 1) = Join(Words)
Next
Range("G3:G" & UBound(CellVals)) = CellVals
End Sub






Note: If you find there are other stand-alone words that you want to appear all lower case, add them to the space delimited list shown in blue above (but make sure the text starts and ends with a space after you have done so).

[PcMax]

Hi,

snb, I tested the code in the loop Vb6 and work perfectly


Sub M_snb()
sn = [B3:B12]

For j = 1 To UBound(sn)
sn(j, 1) = Replace(Replace(StrConv(Replace(Replace(sn(j, 1), ".", ". "), "/", "/ "), 3), ". ", "."), "/ ", "/")

st = Split(sn(j, 1))
For jj = 0 To UBound(st)
If st(jj) Like "*[0-9]*" Then st(jj) = UCase(st(jj))
Next
sn(j, 1) = Join(st)

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) = Trim(Replace(Replace(sn(j, 1) & " ", " " & UCase(it) & " ", " " & it & " "), " " & StrConv(it, 3) & " ", " " & it & " "))
Next
Next

[G3:G12] = sn
End Sub


Rick Rothstein
I tried the code with Excel, perfect
note: Not available in Vb6 code: Application.Proper

Thank you all for the suggestions received

[Rick Rothstein]

Rick Rothstein
I tried the code with Excel, perfect
note: Not available in Vb6 code: Application.Proper

Are you using the VB6 inside of Excel or the compiled version of Visual Basic 6? If you are using the VB6 inside of Excel, what version of Excel are you using? Just so you know, I tested the code before I posted it and what I posted works for me in my copies of XL2003, XL2007 and XL2010 and I can see no reason why it would not work in XL2013 and XL2016 (when released).

If you still have trouble with the code, try replacing Application.Proper with WorksheetFunction.Proper and see if that solves your problem.

Edit Note: Do you have a procedure or function or macro named Proper? If you do, there is a chance using that name is interfering with the attempted use of Proper when called from the Application object.

[PcMax]

Hi,


Application.Proper with WorksheetFunction.Proper
I used XL2013 and the Vba code you have proposed is correct.

I can not use the sequence in the Old program Vb6.
In previous responses I had reported the problem

[Rick Rothstein]

I can not use the sequence in the Old program Vb6.
In previous responses I had reported the problem
If by that you mean the old stand-alone, compiled version of VB6, pretty much nothing offered in an Excel forum will work on it. While VB6 and VBA (what's built into Excel, as well as other Office products) share a large, common core, there are huge differences unique to each which make sharing code back-and-forth between them unlikely to work. VB6 has a richer set of ActiveX controls and its Form is constructed differently from Excel's UserForm... in addition to that, VBA has been hughly extended with the Excel object model which brings hundreds of "extras" to the language that are not duplicated in VB6 at all. In order to move code back-and-forth between the two programming worlds, you need a high degree of familiarity with both so you can recognize when one's code snippet won't work in the other's so that you can write equivalent code to make up the difference.

[PcMax]

Hi,


If by that you mean the old stand-alone, compiled version of VB6, pretty much nothing offered in an Excel forum will work on it.

I confirm that I had to adapt the code to work Vb6

Thank you very much