Initial capital customized

1 Attachment(s)

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

1 Attachment(s)

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

1 Attachment(s)

Hi,

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

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), ". ", "."), "/ ", "/") 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

Here is another macro that you can try...

Code:

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).

Hi,

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

Quote:

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

Quote:

Originally Posted by PcMax

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.

Hi,

Quote:

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

Quote:

Originally Posted by PcMax

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.

Hi,

Quote:

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