Email:      Pass:    Pass?


Advertisements


Free Excel Forum

Find First Lower Case Letter In String - Vba Conumdrum!

Forum Register
Search Excel Forum Posts, Tutorials, Macros, Tips, and More

Hi,

I'm having a nightmare with a VBA problem and wondered if any geniusses out there would be able to help me! Basically I want to compare 2 lists of names from different sources but both are in different formats. One list has the format: First name, Last Name (e.g. Peter Stevens) the other list is in the format LAST NAME, First Name (e.g. STEVENS Peter). There are some people in the list with double barrelled surnames (e.g. SMITH JONES) so I cant use the space character as a separator. The only way I can see of separating the two would be to locate the first occurance of a lowercase letter in the second List. Once I've found the character number in the string I can separate the two names out into the correct format of: First Name, Last Name using the Instr method.

I've written the code below to try and find it but I cant get it to work, the loop just goes all the way through the string and never finds a match. Any pointers would be really appreciated! Thanks

Code:

Option Explicit
Option Compare Binary
 
Sub Test1()
 
Dim StrLen As Integer
Dim ChrNum As Integer
Dim i As Integer
Dim j As Integer
Dim Exitfor As Boolean
Dim str As String
Dim SearchChar As String
 
StrLen = Len(Selection)
str = Selection.Value
For i = 1 To StrLen
 
    Exitfor = False
    For j = 97 To 122 '97-122 lower case ASCII charachers
 
        SearchChar = Chr(j)
        If InStr(i, str, SearchChar, vbBinaryCompare) = 1 Then
            Exitfor = True ' if this equals true the exit loop
            Exit For
        End If
    Next j
 
    If Exitfor = True Then Exit For
 
Next i
 
MsgBox i ' msgbox to return character number of first lower case letter in 
string
 
End Sub





Similar Excel Video Tutorials

Helpful Excel Macros

Complete Guide to Printing in Excel Macros - PrintOut Method in Excel
- This free Excel macro illustrates all of the possible parameters and arguments that you can include in the PrintOut Meth
Capitalize the First Letter of Every Word in a Cell
- This macro will make the text of any selected cell in excel proper case. This means that the first letter of any word in
Enter Text/Characters with a Double-Click of the Mouse
- This macro allows you to enter any text or number, that you specify, in a cell on which you double-click. In the exampl
Extract the First Word from a Cell in Excel - User Defined Delimiter Text Extraction - UDF
- This free Excel UDF (user defined function) returns the first word from a cell in Excel. This extracts the first word f
Format Cells as a Percentage in Excel Number Formatting
- This free Excel macro formats a selection of cells as a Percentage in Excel. This simply changes a cell's number format

Similar Topics







Hi All,

I am having problems (again!!!). I am trying to idenify the first lower case letter in a string. Below is the cloest I have got (It doesnt work at all but doesnt debug)

Code:

 Option Explicit
Sub Test1()
Dim StrLen As Integer
Dim ChrNum As Integer
Dim i As Integer
Dim j As Integer
Dim Exitfor As Boolean
Dim str As String
 
  StrLen = Len(Selection)  
  str = Selection.Value  
  For i = 1 To StrLen  
  Exitfor = False  
  For j = 97 To 122  
  If InStr(i, str, Chr(j), vbBinaryCompare) = 1 Then  
  Exitfor = True  
  Exit For  
  Else  
  MsgBox Chr(j)  
  End If  
  Next j  
  If Exitfor = True Then Exit For  
  Next i  
  MsgBox i  
  End Sub  
 


Any help would be great, thanks in advance


I'm rewriting a function that used to loop through the string with one that uses regular expressions instead:

This is the old function:

Code:

Private Function IsRoman(chk As String) As Boolean
Dim rmn As String, z As Integer, sv As Integer
If chk = "" Then Exit Function
rmn = "MCLXDIV"
IsRoman = True
For z = 1 To Len(chk)
     If InStr(1, rmn, Mid(chk, z, 1)) = 0 Then
        IsRoman = False
        Exit For
    End If
Next
End Function


This is not intended to see if it is a valid roman numeral (nor does it need to), only whether the string contains only those characters or not. Once it finds a nonvalid character and returns FALSE.

But now, I'm thinking I could eliminate the loop and use Regular Expressions.

I tried this first, but this doesn't work, as it returns TRUE if any letter matches, not every character in the entire string.

Code:

Public Function IsRoman(chk As String) As Boolean
Dim rmn As String
rmn = "(M|C|L|X|D|I|V)"
With CreateObject("vbscript.regexp")
    .Pattern = rmn
    .Global = True
    IsRoman = .test(chk)
End With
End Function


I came up with this one, which works, but I was wondering if there was anything I could've put in that would've allowed .test to work to match every character in the string to the pattern.

Code:

Public Function IsRoman(chk As String) As Boolean
Dim rmn As String
rmn = "(M|C|L|X|D|I|V)"
With CreateObject("vbscript.regexp")
    .Pattern = rmn
    .Global = True
    IsRoman = Len(.Replace(chk, "")) = 0
End With
End Function





Hello,

I need help with the dynamic range names created programmatically.

Follwing code generates the range names! When I tries to refer them as
"workbook.xls"!"rangename" I get error message 'refence is not valid' !

I am unable to figure this! I need to use all these range names in charts,
which I intend to create programmatically.

Thanks

Mike

Sub DynamicRangeNames()

Dim intRow_Num As Integer
Dim strRangeName As String
Dim ch As ChartObject, x
Dim SearchString, SearchChar, MyPos As Integer
Dim strSheetName As String, strCoverSheet As String
Dim strSheetNameNew As String
Dim isheet As Integer, i As Integer, j As Integer
Dim iRowNum As Integer, iColNum As Integer
Dim iReportRowNum As Integer, iReportColNum As Integer
Dim strMonthName As String, strPrevMonthName As String
Dim imonth As Integer, intNewGroup As Integer
Dim strYearname As String, strReportName As String


For i = 1 To ActiveWorkbook.Sheets.Count

strSheetName = ActiveWorkbook.Sheets(i).Name
strSheetNameNew = strSheetName
intNewGroup = 4
Select Case strSheetName

Case "Cover Sheet", "Template", "Old Template", "Charts"
'Do nothing, ignore this worksheets
Case Else

For intRow_Num = 3 To 36
If IsEmpty(Sheets(strSheetName).Cells(intRow_Num,
1)) Then
intNewGroup = intRow_Num + 1
intRow_Num = intRow_Num + 1
Else
intRow_Num =
Sheets(strSheetName).Cells(intRow_Num, 1).Row
strRangeName =
Trim(Sheets(strSheetName).Cells(1, 1).Value) & "_" & _
Trim(Sheets(strSheetName).Cells(intNewGroup,
1).Value) & _
"_" &
Trim(Sheets(strSheetName).Cells(intRow_Num, 1).Value)
Do
MyPos = InStr(1, strRangeName, " ",
vbBinaryCompare)
If MyPos > 0 Then
Mid(strRangeName, MyPos, 1) = "_"
End If
Loop Until MyPos <= 0

Do
MyPos = InStr(1, strRangeName, "-",
vbBinaryCompare)
If MyPos > 0 Then
Mid(strRangeName, MyPos, 1) = "_"
End If
Loop Until MyPos <= 0

Do
MyPos = InStr(1, strSheetNameNew, " ",
vbBinaryCompare)
If MyPos > 0 Then
Mid(strSheetNameNew, MyPos, 1) = "_"
End If
Loop Until MyPos <= 0

Do
MyPos = InStr(1, strSheetNameNew, "-",
vbBinaryCompare)
If MyPos > 0 Then
Mid(strSheetNameNew, MyPos, 1) = "_"
End If
Loop Until MyPos <= 0
ActiveWorkbook.Names.Add Name:=strRangeName,
RefersTo:= _
"=OFFSET(" & strSheetNameNew & "!" &
Sheets(strSheetName).Cells(intRow_Num, 1).Address & _
",0,1,,COUNTA(" & strSheetName & "!$" & _
intRow_Num & ":$" & intRow_Num & ")-1)"
End If
Next
End Select
Next

End Sub





Hello, all
[Using the simple example from the vba help files, the following
returns 9:]
Sub StringPractice()
Dim SearchString, SearchChar, MyPos
SearchString = "XXpXXpXXPXXP" ' String to search in.
SearchChar = "P" ' Search for "P".
' A binary comparison starting at position 1. Returns 9.
MyPos = InStr(1 , SearchString, SearchChar, 0)
MsgBox MyPos
End Sub

Obviously the first occurrence of "P" is in the 9 pos when starting at
beginning of SearchString... BUT WHY, when I substitute any other
number for a starting position, click on reset, then run sub again,
does the answer ALWAYS RETURN A 9??? Does the constant vbBinaryCompare
not support the use a starting-position number w/ InStr???
Thanks much for your time [:-))

terry b.




This code is a little complicated to explain. Basically, I am just wondering if anyone can point out any syntax errors. The code will not execute. The "Dyn_Sequence" is just a string that is "CTTTCTTTC0". I'm trying to create a while loop that will step through the string and execute case commands based on what is in the string. "seq_ptr" is just a pointer that points to a certain character in the string. The while loop keeps going until the "seq_ptr" hits the value "0." At this point I know it is the end of my string and I can stop executing Case Commands. By the way, I just used a while loop because I am more comfortable with them. If there is a way to use a for loop and have it go until it reaches the length of the string then I could do that too.

Code:

Dim sequence(0 To 15)
Dim seq_ptr As Integer
Dim seq As Integer
Dim c_offset As Integer
Dim t_offset As Integer


While seq_ptr + 1  0
    seq = 0
    If Mid(Dyn_Sequence, seq_ptr, 3) = "CTC" Then
        seq = 1
    End If
    If Mid(Dyn_Sequence, seq_ptr, 4) = "CTTC" Then
        seq = 2
    End If
    If Mid(Dyn_Sequence, seq_ptr, 5) = "CTTTC" Then
        seq = 3
    End If
    Select Case (seq)
        Case (0)
        MsgBox ("Not a valid test sequence")
        Exit Sub
        Case (1)
        r(t_offset) = t(t_offset) / ((c(c_offset) + c(1 + c_offset)) / 2)
        seq_ptr = seq_ptr + 2
        t_offset = t_offset + 1

        Case (2)
        r(t_offset) = t(t_offset) / (((2 * c(c_offset)) + c(1 + c_offset)) / 3)
        r(1 + t_offset) = t(1 + t_offset) / ((c(c_offset) + (2 * c(1 + c_offset))) / 3)
        seq_ptr = seq_ptr + 3
        t_offset = t_offset + 2
        
        Case (3)
        r(t_offset) = t(t_offset) / (((3 * c(c_offset)) + c(1 + c_offset)) / 4)
        r(1 + t_offset) = t(1 + t_offset) / ((c(c_offset) + c(1 + c_offset)) / 2)
        r(2 + t_offset) = t(2 + t_offset) / ((c(c_offset) + (3 * c(1 + c_offset))) / 4)
        seq_ptr = seq_ptr + 4
        t_offset = t_offset + 3
    End Select
    c_offset = c_offset + 1
Wend





Hi there,

I've put together a procedure that deletes the first letter in each string
in a column of data. It works, but I can't help feel there's a more
efficient way of doing this. For example, is there a way of just editing
the string itself rather than taking a virtual copy and then replacing the
original as I've done here?

All comments most welcome.

Thanks

John


Sub RemoveFirstLetterInList()
'Deletes first letter in string per cell in list
Dim rgListItem As Range
Dim newStr As String
Dim ll As Integer
Dim r As Integer
Dim c As Integer
Dim totalStr As String

'Check user selects cell at top of list
Answer = MsgBox(Prompt:="Is cell at top of list selected?", Buttons:=vbYesNo
+ vbQuestion)
If Answer = vbNo Then Exit Sub

r = ActiveCell.Row
c = ActiveCell.Column

Do
Set rgListItem = Cells(r, c)
If IsEmpty(Cells(r, c)) Then Exit Do
totalStr = rgListItem.Value
ll = Len(totalStr) - 1
newStr = Right(totalStr, ll)
rgListItem.Value = newStr

r = r + 1
Loop

Cells(r, c).Select

MsgBox "Finished"

End Sub





I have some text in cell C2 that looks like this: clonidine_Area
I want to copy the text before the underscore and paste it to another cell.

I've gotten this far but don't know how to proceed... How do I use the position number to selectively copy the string that I want? Any help would be greatly appreciated.


Sub Cp()

Dim SearchString, SearchChar, MyPos

SearchString = ActiveSheet.Range("C2")
SearchChar = "_"

MyPos = InStr(1, SearchString, SearchChar, 1)



End Sub


Hi,

I am trying to create a table (two-dimensional array actually) that has in first column (or dimension) a number that represents a position in a string and in second column whether that position in a string is a starting tag (1) or an ending tag (2).

To give you first an example, let's take string "http://www.mrexcel.com/forum/newthread.php?do=newthread&f=10", where we could say the starting tag is "a" and ending tag is "e". In other words, the result should be

14 2
17 2
31 2
36 2
37 1
48 2
53 2
54 1

Now, I thought to do this so that I save first the string I process as sItem and as sOrigItem, then begin to process the string from the start of the string, find both next starting and ending tag (in this example those are 14 and 37) and then compare those numbers to each other and add smaller (here, 14) to the array as the cell(i,1), where i of course represents the row. After that, I cut the string with "Right(item, Len(item) - InStr(1, item, sAlkuTagi))" and then loop that until... what? Until it gives an error or how do I check there's no more starting or ending tags?

Ok, then the solution I have so far as a code

Code:

Sub SplitTest()
    Dim item As String
    Dim aiTL() As Integer 'Tag locations
    Dim sOrigItem As String 'The original string
    Dim iNST As Integer 'Next starting tag
    Dim iNET As Integer 'Next ending tag
    
    Dim sSTag As String 'Starting tag
    Dim sETag As String 'Ending tag
    Dim i As Integer 'Keeps count of tags
    
    sOrigItem = "http://www.mrexcel.com/forum/newthread.php?do=newthread&f=10"
    item = sOrigItem
    
    sSTag = "a"
    sETag = "i"
    
    If sSTag = sETag Then
        MsgBox "Starting and ending tag can't be the same!"
        Exit Sub
    End If
    
    i = 1
    
    Do Until (InStr(1, item, sSTag) = 0) And (InStr(1, item, sETag) = 0) 'Is this the right way to check when the loop is done?
    'This array has two dimensions. One tells where the tag is, 
    'other whether it is a starting tag (1) or an ending tag (2).
        ReDim Preserve aiTL(1 To i, 1 To 2)
        iNST = InStr(1, item, sSTag)
        iNET = InStr(1, item, sETag)
        
        If i > 1 Then
            If iNST < iNET Then 'Next found tag is a starting tag
                aiTL(i, 1) = aiTL(i - 1, 1) + InStr(1, item, sSTag)
                aiTL(i, 2) = 1 'So this is marked as a starting tag
            ElseIf iNET < iNST Then 'Next found tag is an ending tag
                aiTL(i, 1) = aiTL(i - 1, 1) + InStr(1, item, sETag)
                aiTL(i, 2) = 2 'So this is marked as a ending tag
            Else
                MsgBox "Some unknown error (The next tag is neither starting nor ending tag)"
                Exit Sub
            End If
        Else 'Needs an if-clause so that it wouldn't point over the begin of array ie. to row 0
            If iNST < iNET Then
                aiTL(i, 1) = aiTL(i, 1) + InStr(1, item, sSTag)
                aiTL(i, 2) = 1
            ElseIf iNET < iNST Then
                aiTL(i, 1) = aiTL(i, 1) + InStr(1, item, sETag)
                aiTL(i, 2) = 2
            Else
                MsgBox "Some unknown error (The next tag is neither starting nor ending tag)"
                Exit Sub
            End If
        End If
        
        'Calculates the remaining string
        item = Right(item, Len(item) - InStr(1, item, sSTag))
        i = i + 1
    Loop
    
End Sub


So the two questions I have
1) How do I code in the ending condition
2) Why does this code now subscript out of range error in that "redim preserve..." row?


Hi all,

I have a listbox, a text input field and an add button.

When a user enters a string into input field and hits add, i want that string to appear as a new entry in the list box. Code I have so far (in its entirety):

Code:

Private Sub add_agent_Click()
    '1 - check it name already exists or not
    '2 - fix up first letter of each name to uppercase
    '3 - make sure there is a space (indicating two names)
    '4 - add to list
    
    Dim agent_sheet As Worksheet
    Set agent_sheet = Worksheets("agents")
    
    Dim new_agent As String
    new_agent = Trim(control_panel_form.agent_name.value)
    
    If InStr(1, new_agent, " ") = 0 Then
        MsgBox "Please enter first name and last name"
        Exit Sub
    End If
    
    Dim i As Integer
    
    For i = 1 To xlLastRow(agent_sheet.Name)
        If new_agent = agent_sheet.Range("C" & i) Then
            MsgBox new_agent & " already exists!"
            Exit Sub
        End If
    Next
    
    control_panel_form.agent_list.AddItem new_agent
    Unload control_panel_form
    Load control_panel_form
    control_panel_form.Show

    MsgBox new_agent
    
End Sub


But obviously this is not working!


Can anyone help out?




I need to make sure textbox entries follow certain rules so that values passed to a modules doesn't crash while calculating. Textbox entries must be positive numbers and must not conatain any alpha characters or invalid characters such as blanks, symbols, etc. When tabbing to the next textbox, the textbox needs to be tested and if invalid entries are found then focus needs to be put back on that textbox until a valid number is entered. Not all of the message box calls are in their final form. I've been having problems getting some of the message boxes to close and return to the textboxes for new entries. (See below, attached .xlsm file might make more sense; 1st tab explains validation rules)

**************************************************************************************************************
**************************************************************************************************************


Private Sub TextBox_a_Exit(ByVal Cancel As MSForms.ReturnBoolean)

' Validate textbox on exit by checking for text entry, blanks, negative numbers, and zero
Dim avalue As Double
Dim ContainsInvalidCharacter As Boolean
Dim Counter As Integer
Dim Mbxret As Integer
Dim StrPrompt1 As String
Dim StrPrompt2 As String
Dim StrPrompt3 As String

Dim StrTitle As String

StrPrompt1 = "Sorry, only non-negative numbers allowed."
StrPrompt2 = "Sorry, must have a value" & vbCrLf & "Only non-zero and non-negative numbers allowed."
StrPrompt3 = "Sorry, invalid character entered"
StrTitle = "Constant a"

With Me.ActiveControl

Do While (Not IsNumeric(TextBox_a.Value))
TextBox_a.SetFocus


Select Case (Not IsNumeric(Me.ActiveControl))

Case (Not IsNumeric(Me.ActiveControl))
Mbxret = MsgBox(StrPrompt1, vbOKOnly, StrTitle)
If Mbxret = vbOK Then Cancel = True
TextBox_a.SetFocus
Exit Do
Case vbNullString
Mbxret = MsgBox(StrPrompt2, vbOKOnly, StrTitle)
If Mbxret = vbOK Then Cancel = True
TextBox_a.SetFocus

End Select

Loop

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'ContainsInvalidCharacter = True



If Me.TextBox_a.Value <> vbNullString Then
Do
ContainsInvalidCharacter = True
'Iterate through each character and determine if its a number,
'letter, or non-number of string.
For Counter = 1 To Len(TextBox_a.Value)

Select Case Asc(Mid(TextBox_a.Value, Counter, 1))
Case 45 To 46
ContainsInvalidCharacter = False

Case 48 To 57, 65 To 90, 97 To 122
ContainsInvalidCharacter = False

Case Else

ContainsInvalidCharacter = True
'TextBox_a.Value = vbNullString
'SendKeys "+{TAB}" ' This goes back to TextBox
TextBox_a.SetFocus
Exit For

End Select

Next


'If ContainsInvalidCharacter Then
'Contains a non alpha or numeric character
Mbxret = MsgBox(StrPrompt3, vbOKOnly, StrTitle)
If Mbxret = vbOK Then Cancel = True
TextBox_a.SetFocus
Exit Do
Loop Until ContainsInvalidCharacter = False


'Else no invalid characters found

'Else


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
avalue = CDbl(Val(Me.TextBox_a.Value))
Select Case avalue
Case Is < 0
MsgBox "Sorry, only non-negative numbers allowed.", vbOKOnly, "Constant a"
SendKeys "+{TAB}" ' This goes back to TextBox
TextBox_a.SetFocus

Case Is = 0
MsgBox "Constant a is non-zero and positive", vbOKOnly, "Constant a"
SendKeys "+{TAB}" ' This goes back to TextBox
TextBox_a.SetFocus

End Select
End If
'Else:
' MsgBox "Sorry, must have a value" & vbCrLf & "Only non-zero and non-negative numbers allowed.", vbOKOnly, "Constant a"

'End If

'SendKeys "+{TAB}" ' This goes back to TextBox
'TextBox_a.SetFocus
End With
End Sub

Is there a way to loop though a string and pull out each letter and assign it to its own variable that can be recaled using Letter1 letter2 ect?

Code:

Sub IndivLetter()

Dim num As Integer
Dim strArray() As String
Dim strText As String
Dim lLoop As Long, lCount As Long
Dim Letter(1 To 20)  As Variant



'pull out each letter and assign numeric value
strText = "Thisisareallylongstringtestwithnospaces"
    lCount = Len(strText)
    ReDim strArray(lCount - 1)

        For lLoop = 0 To lCount - 1
            y = lLoop
            strArray(lLoop) = Mid(strText, lLoop + 1, 1)
            Letter & lLoop  = strArray(lLoop)
            
        Next lLoop

     MsgBox Letter1
     MsgBox Letter4

End Sub



I have gotten this to work with a message box but I want to have each letter be assigned as it's own varible or string.
Code:

For Counter = 1 To Len(part3)

Letter & Counter = Mid(part3, Counter, 1)
    'do something to each character in string
    'here we'll msgbox each character
    MsgBox Mid(part3, Counter, 1)
Next





This is a loop previously set up for extracting the capitalised words from a string and displaying them in messageboxes, but it seems to only output the last name in the list in my situation.
I've tried various of modifications to the strings it checks for, I don't understand why it won't isolate the other names.


Code:

Sub SurnameIsolator()
Dim ChrUString As String
Dim Start As Integer
Dim Finish As Integer
ChrUString = "Alan BUNNY / Peter THOMPSON / Sarah HINKLEY"
Start = 1
Do While Finish <> InStrRev(ChrUString, " ")
    Finish = InStr(Start + 1, ChrUString, " ")
    If Mid(ChrUString, Start, Finish - Start) = UCase(Mid(ChrUString, Start, Finish - Start)) Then If InStr(ChrUString, " ") = 0 Then MsgBox Mid(ChrUString, Start, Finish - Start)
    Start = InStr(Finish, ChrUString, " ")
Loop
If Right(ChrUString, Len(ChrUString) - InStrRev(ChrUString, " ")) = UCase(Right(ChrUString, Len(ChrUString) - InStrRev(ChrUString, " "))) Then MsgBox Right(ChrUString, Len(ChrUString) - InStrRev(ChrUString, " "))
End Sub





Hi All,

I have to write a sub that compares the password that I put in an input box to range of passwords (1000 in all) in column A. if there is a duplicate it should display a message asking to enter a new password . here is the code that I have written .... cant seem to figure out the mistake....

thanks for your help.....

' Example 6 page 103 Chapter 7 Christian Albright VBA for Modelers

Sub newPassword2()

Dim newPass As String, valid As Boolean, i As Integer, newPass2 As String, oldPassword As Range, MyCount As Integer, noldPass As String
Dim res As Boolean
With Range("a1")

Range(.Offset(0, 0), .End(xlDown)).Name = "noldPass"
Set oldPassword = Range("noldPass")
End With

MyCount = Application.CountA(oldPassword)

MsgBox "Oldpassword has " & MyCount & " passwords"

valid = False
' This do loop will check if you have entered the correct password
Do Until valid
newPass = InputBox("Please enter your new password consisting of uppercase letters & digits")
If vbCancel Then Exit Sub
'this loop check for the conditions of the new password.
'If Len(newPass) > 8 And newPass UCase(newPass) Then
'Use or so that if anything is true it will ask you to re- enter
If newPass UCase(newPass) Or InStr(newPass, " ") 0 Then
MsgBox "The password has to be upper case and only digits no spaces" & _
" re-enter", vbInformation, "Re-enter the Password"

res = Application.WorksheetFunction.Match(newPass, oldPassword, 0)

If IsError(res) = True Then
MsgBox "This password has been selected, select a new Password", vbInformation, "Duplicate Password"

Else
valid = True
MsgBox " Congratulations you entered a new Password"
Range("a1").Offset(MyCount, 0) = newPass

End If
End If

Loop
en d Sub
P.S - Some of the formatting is screwed up


Hi all,

My code is meant to ensure a string in a cell begins with three letters and ends with 5 numbers. It seems to work, but how can I exit the loop and go to the message box once the boolean variable is set to true? I was hoping to avoid using labels. Also, I would appreciate any suggestions in compacting the code if possible, but without using CreateObjects". Thank you


Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("h17")) Is Nothing Then Exit Sub

Dim Ls As String
Dim i As Integer, z As Integer
Dim MyString As String
Dim MyClVal As String: MyClVal = Target.Value
Dim MyBL As Boolean: MyBL = False

If Len(MyClVal)  8 Then Exit Sub

Rem FIRST THREE STRINGS ARE LETTERS
For i = 1 To 3
    MyString = Asc(Mid(UCase(Range("H17").Value), i, 1))
    If MyString < 65 Or MyString > 90 Then
    MyBL = True
    End If
Next i

Rem LAST 5 STRINGS ARE NUMBERS
MyString = ""
For z = 4 To 8
    MyString = Asc(Mid(UCase(Range("H17").Value), z, 1))
    If MyString < 48 Or MyString > 57 Then
    MyBL = True
    End If
Next z

Rem MESSAGE IF ERROR
If MyBL Then
    MsgBox "You must enter a valid number." & vbLf & vbLf & _
    "Please try again."
    Target.ClearContents: Target.Activate
    Else
    Range("h17") = StrConv(Range("h17"), vbUpperCase)
End If

End Sub





Hello,

My question is about converting a Literal String to Character Code.

Here's why. I'm using the following coded InputBox. And it prompts the user for what characters to search for in a string.

Code:

Sub FindChar()

    CharToFind = InputBox("Please enter char to search for")

    Result = InStr(1, Text, CharToFind, 1)

    If Result <> 0 Then
       MsgBox "The char was found in the text at character number " & Result
    Else
       MsgBox "The char was not found."
    End If
End Sub


The above code works great if I enter a letter or an integer. But I need to allow the user to enter carriage returns in ANSI code, such as Chr(13).

As of now, if the user enters "Chr(13)" then the CharToFind variable actually contains the literal string in quotes, not the character code without the quotes. So that the final search string is essentially what's shown below:

Code:

Result = InStr(1, Text, "Chr(13)", 1) ' with quotes

' When what i want it to represent is:
Result = InStr(1, Text, Chr(13), 1) ' without quotes


So my question is, how do i convert the variable CharToFind's value of "Chr(13)" to a value of Chr(13)?

Is there a common way of doing this? A function, perhaps, that does this sort of conversion? I would be grateful for some direction in my dilemma.

Thanks for any and all help!


Function Format_Code128 (InString As String) As String
Dim Sum As Integer, i As Integer
Dim Checksum As Integer, Checkchar As Integer
Dim MyString As String, CVal As Integer

' Initialize running total with value of
' Subset B start character

Sum = 104

' Scan the string and add character value times position

For i = 1 To Len(InString)

' Copy one character from InString position i to MyString

MyString = Mid$(InString, i, 1)

' Get the numeric value of the character and subtract
' 32 to shift (the space character, ASCII value 32, has
' a numeric value of 0 as far as Code 128 is concerned)

CVal = Asc(MyString) - 32

' Add the weighted value into the running sum

Sum = Sum + (CVal * i)
Next i

' Calculate the Modulo 103 checksum

Checksum = Sum Mod 103

' Now convert this number to a character.

If Checkdigit = 0 Then
Checkchar = 174
ElseIf Checkdigit < 94 Then
Checkchar = Checkdigit + 32
Else
Checkchar = Checkdigit + 71
End If

' Now format the final output string: start character,
' data, check character, and stop character

MyString = Chr(162) + InString + Chr(Checkchar) + Chr(164)
Format_Code128 = MyString
End Function

Hi,

I have code above User Define funtion in Excel and converted my data
(example CCF001257) into code 128 B of Barcode symbology..the UDF returns
value as
¢CCF001257®¤ but when in change it into code 128 font with 20 font size the
scanner does not reads it.. where is the problem lies ...

Regards,

safi.





Function Format_Code128 (InString As String) As String
Dim Sum As Integer, i As Integer
Dim Checksum As Integer, Checkchar As Integer
Dim MyString As String, CVal As Integer

' Initialize running total with value of
' Subset B start character

Sum = 104

' Scan the string and add character value times position

For i = 1 To Len(InString)

' Copy one character from InString position i to MyString

MyString = Mid$(InString, i, 1)

' Get the numeric value of the character and subtract
' 32 to shift (the space character, ASCII value 32, has
' a numeric value of 0 as far as Code 128 is concerned)

CVal = Asc(MyString) - 32

' Add the weighted value into the running sum

Sum = Sum + (CVal * i)
Next i

' Calculate the Modulo 103 checksum

Checksum = Sum Mod 103

' Now convert this number to a character.

If Checkdigit = 0 Then
Checkchar = 174
ElseIf Checkdigit < 94 Then
Checkchar = Checkdigit + 32
Else
Checkchar = Checkdigit + 71
End If

' Now format the final output string: start character,
' data, check character, and stop character

MyString = Chr(162) + InString + Chr(Checkchar) + Chr(164)
Format_Code128 = MyString
End Function

Hi,

I have code above User Define funtion in Excel and converted my data
(example CCF001257) into code 128 B of Barcode symbology..the UDF returns
value as
¢CCF001257®¤ but when in change it into code 128 font with 20 font size the
scanner does not reads it.. where is the problem lies ...

Regards,

safi.





Function Format_Code128 (InString As String) As String
Dim Sum As Integer, i As Integer
Dim Checksum As Integer, Checkchar As Integer
Dim MyString As String, CVal As Integer


' Initialize running total with value of
' Subset B start character

Sum = 104

' Scan the string and add character value times position

For i = 1 To Len(InString)

' Copy one character from InString position i to MyString

MyString = Mid$(InString, i, 1)

' Get the numeric value of the character and subtract
' 32 to shift (the space character, ASCII value 32, has
' a numeric value of 0 as far as Code 128 is concerned)

CVal = Asc(MyString) - 32

' Add the weighted value into the running sum

Sum = Sum + (CVal * i)
Next i

' Calculate the Modulo 103 checksum

Checksum = Sum Mod 103

' Now convert this number to a character.

If Checkdigit = 0 Then
Checkchar = 174
ElseIf Checkdigit < 94 Then
Checkchar = Checkdigit + 32
Else
Checkchar = Checkdigit + 71
End If
'
' Now format the final output string: start character,
' data, check character, and stop character
'
MyString = Chr(162) + InString + Chr(Checkchar) + Chr(164)
Format_Code128 = MyString
End Function

I Have coded above UDF to construct data (my data is like "CCF001257") the
UDF returns value as

¢CCF001257®¤ but when I changed this into 128 font and took printout the
scanner is not reconging it..what will be the problem..will any one trace out
...i have a doubt..
1.code 128 and code 128 B fonts are different if so..
2. shall i have to use Code 128 B font

does this will slove..

Plz tell me soon...

Regards,

safi.




This formula decomposer parses a cell formula and splits it up in multiple rows with indents to make understanding a complex cell formula a bit easier.

I believe the output could be improved (not sure what would be more useful, but ...) so I submit it to the group wisdom.

Please review and make improvements where needed.
Code:

Sub FormulaDecomposer()

    Dim intX As Integer
    Dim booExists As Boolean
    Dim intNestCount As Integer
    Dim intNextRow As Integer
    Dim intOpen As Integer
    Dim intClose As Integer
    Dim strInput As String
    Dim intNextAscii As Integer
    
    For intX = 1 To Sheets.Count
        If Sheets(intX).Name = "Formula Decon" Then
            Range("A3").CurrentRegion.Cells.ClearContents
            booExists = True
            Exit For
        End If
    Next
    If Not booExists Then Worksheets.Add(Befo =Sheets(1)).Name = "Formula Decon"
    If Len(Trim(Worksheets("Formula Decon").Range("A1"))) = 0 Then
        strInput = InputBox("Enter Formula", "Enter", "()")
    Else
        strInput = Trim(Worksheets("Formula Decon").Range("A1"))
    End If
    
    intOpen = 0
    intClose = 0
    For intX = 1 To Len(strInput)
        If Mid(strInput, intX, 1) = "(" Then intOpen = intOpen + 1
        If Mid(strInput, intX, 1) = ")" Then intClose = intClose + 1
    Next
        
    If intOpen  intClose Then MsgBox "Unbalanced parenthesis.":                 Exit Sub
    If intOpen = 0 Then MsgBox "No parenthesis.": Exit Sub
    
    
    With Worksheets("Formula Decon")
        .[A1] = Chr(32) & strInput
        
        intNextRow = 3
        intNestCount = 0
        Do While Len(strInput) > 0
            intNextAscii = NextDelimiter(strInput)
            Select Case intNextAscii
            Case 40, 123, 91 'Open Parens - All up to and including ( into ready row, next column
                intNestCount = intNestCount + 1
                .Cells(intNextRow, intNestCount) = _
                    Chr(32) & Left(strInput, InStr(strInput, Chr(intNextAscii)))
                strInput = Mid(strInput, InStr(strInput, Chr(intNextAscii)) + 1)
            Case 41, 125, 93 'Close Parens - All up to and including ) in current row, current column 1 col left for next
                    intNestCount = intNestCount + 1
                    .Cells(intNextRow, intNestCount) = Chr(32) & Left(strInput, InStr(strInput, Chr(intNextAscii)) - 1)
                    intNestCount = intNestCount - 1
                    If Left(strInput, 1)  ")" Then intNextRow = intNextRow + 1
                    .Cells(intNextRow, intNestCount) = Chr(32) & Chr(intNextAscii)
                    strInput = Mid(strInput, InStr(strInput, Chr(intNextAscii)) + 1)
                    intNestCount = intNestCount - 1
            Case 44  'Comma - comma in same cell as was last written
'                If Right(.Cells(intNextRow, intNestCount).Offset(-1, 1).Value, 1) = ")" Then
'                    .Cells(intNextRow, intNestCount).Offset(-1, 1) = _
'                        .Cells(intNextRow, intNestCount).Offset(-1, 1) & _
'                        Left(strInput, InStr(strInput, Chr(intNextAscii)))
'                Else
                    .Cells(intNextRow, intNestCount) = .Cells(intNextRow, intNestCount) & _
                        Left(strInput, InStr(strInput, Chr(intNextAscii)))
                'End If
                strInput = Mid(strInput, InStr(strInput, Chr(intNextAscii)) + 1)
                'intNextRow = intNextRow - 1
                
            Case Else 'No delimiters left
                If intNestCount = 0 Then intNestCount = 1
                .Cells(intNextRow, intNestCount) = Chr(32) & strInput
                strInput = ""
            End Select
            intNextRow = intNextRow + 1
        Loop
        
        Range("A3").Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Columns.AutoFit
        
        Rows("2:2").Select
        ActiveWindow.FreezePanes = True
        Range("A3").Select
        
    End With

End Sub


Function NextDelimiter(strInput As String)
    'Look for  (40(  )41) ,44,  :58:   ]93]   [91[   }125}  {123{
    'in string and return which one is next
    
    Dim aryDelimiters
    Dim aryLocation
    Dim intPosition As Integer
    Dim intNext As Integer
    Dim intX As Integer
    '                      40   41   44   123  125  91   93
    aryDelimiters = Array("(", ")", ",", "{", "}", "[", "]")
    aryLocation = Array(InStr(strInput, "("), _
        InStr(strInput, ")"), _
        InStr(strInput, ","), _
        InStr(strInput, "{"), _
        InStr(strInput, "}"), _
        InStr(strInput, "["), _
        InStr(strInput, "]"))
    
    intPosition = 32000
    For intX = LBound(aryDelimiters) To UBound(aryDelimiters)
        If aryLocation(intX) > 0 And aryLocation(intX) < intPosition Then
            intNext = intX
            intPosition = aryLocation(intX)
        End If
    Next
    If intPosition = 32000 Then
        NextDelimiter = 0
    Else
        NextDelimiter = Asc(aryDelimiters(intNext))
    End If
End Function





Hello,
I need to write a macro that will search for predefined criteria and delete it. The find results have to be whole words and can appear as the last thing in a cell, so there's not always a space preceeding/following the word.

I was able to find a macro that does exactly what I want, but it's programmed with an input box to do one at a time finds. This is highly inconvenient as I have 20+ finds to do, so I need to be able to loop through all of my finds. I tried to tweak this macro with no success.

Here's the macro that does work:



Sub OneAtATime()
Dim WorkRange As Range
Dim OldStr As Variant
Dim NewStr As Variant
Dim Match As Variant
Dim c As Range
Dim Punc As Variant
Dim x As Integer
Dim y As Integer
Dim Str As String
Dim Pos As Integer
Dim OldPos As Integer
On Error Resume Next
Set WorkRange = Selection.SpecialCells(xlCellTypeConstants, 2)
If Err 0 Then
MsgBox "No cells found"
Exit Sub
End If
On Error GoTo 0
OldStr = InputBox("Replace what", "Replace whole word")
If OldStr = "" Then Exit Sub
NewStr = InputBox("Replace with", "Replace whole word")
' Match = MsgBox("Match Case?", vbYesNo, "Replace whole word")
' If Match = vbYes Then Match = vbBinaryCompare Else Match = vbTextCompare
Punc = Array(" ", ",", ";", ":", ".")
For Each c In WorkRange
If StrComp(c.Value, OldStr, Match) = 0 Then
c.Value = NewStr
End If
If StrComp(Left(c.Value, Len(OldStr)), OldStr, Match) = 0 Then
For x = LBound(Punc) To UBound(Punc)
If StrComp(Left(c.Value, Len(OldStr) + 1), OldStr & Punc(x), Match) = 0 Then
c.Value = NewStr & Mid(c.Value, Len(OldStr) + 1, Len(c.Value) - Len(OldStr))
Exit For
End If
Next x
End If
If StrComp(Right(c.Value, Len(OldStr)), OldStr, Match) = 0 Then
For x = LBound(Punc) To UBound(Punc)
If StrComp(Right(c.Value, Len(OldStr) + 1), Punc(x) & OldStr, Match) = 0 Then
c.Value = Left(c.Value, Len(c.Value) - Len(OldStr)) & NewStr
Exit For
End If
Next x
End If
For x = LBound(Punc) To UBound(Punc)
For y = LBound(Punc) To UBound(Punc)
Str = Punc(x) & OldStr & Punc(y)
OldPos = 1
Do
Pos = InStr(OldPos, c.Value, Str, 1)
If Pos > 0 Then
If StrComp(Mid(c.Value, Pos, Len(Str)), Str, Match) = 0 Then
c.Value = WorksheetFunction.Substitute(c.Value, Mid(c.Value, Pos, Len(Str)), Punc(x) & NewStr & Punc(y), 1)
Exit For
End If
End If
OldPos = Pos + 1
Loop While Pos > 0
Next y
Next x
c.Value = WorksheetFunction.Trim(c.Value)
Next c
End Sub



I would appreciate any help to tweak this macro. I would prefer to build an array of the values to be searched for. Another option which would be okay, would be to add a worksheet and in column A, I could enter all values for searching - not sure which is easier.

Thanks,
Michelle


Hello everyone,

Right now I'm trying to get a list of all the possible combos of days off during a week. Currently I'm using a series of 1's and 0's to show what days a schedule has off.

Ex: 1011101 that series means Monday/Friday off.

So basically I'm trying to find a way to show all the possible combos of 1's and 0's in a series of 7. Both with two 0's and 3 0's, corresponding to two days off and 3 days off in a week.

I found this bit of code that sounded like it would do what I needed, however trying to execute it produces an overflow error and I'm not sure how to go about fixing that. Any help would be appreciated.

Thanks

Code:

Option Explicit

Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet
'
' Myrna Larson, July 25, 2000, Microsoft.Public.Excel.Misc

Sub ListPermutationsOrCombinations()
Dim Rng As Range
Dim PopSize As Integer
Dim SetSize As Integer
Dim Which As String
Dim n As Double
Const BufferSize As Long = 4096

Worksheets("Sheet1").Range("A1").Select
Set Rng = Selection.Columns(1).Cells
If Rng.Cells.Count = 1 Then
Set Rng = Range(Rng, Rng.End(xlDown))
End If

PopSize = Rng.Cells.Count - 2
If PopSize < 2 Then GoTo DataError

SetSize = Rng.Cells(2).Value
If SetSize > PopSize Then GoTo DataError

Which = UCase$(Rng.Cells(1).Value)
Select Case Which
Case "C"
n = Application.WorksheetFunction.Combin(PopSize, SetSize)
Case "P"
n = Application.WorksheetFunction.Permut(PopSize, SetSize)
Case Else
GoTo DataError
End Select
If n > Cells.Count Then GoTo DataError

Application.ScreenUpdating = False

Set Results = Worksheets.Add

vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
ReDim Buffer(1 To BufferSize) As String
BufferPtr = 0

If Which = "C" Then
AddCombination PopSize, SetSize
Else
AddPermutation PopSize, SetSize
End If
vAllItems = 0

Application.ScreenUpdating = True
Exit Sub

DataError:
If n = 0 Then
Which = "Enter your data in a vertical range of at least 4 cells." _
& String$(2, 10) _
& "Top cell must contain the letter C or P, 2nd cell is the Number" _
& "of items in a subset, the cells below are the values from Which" _
& "the subset is to be chosen."

Else
Which = "This requires " & Format$(n, "#,##0") & _
" cells, more than are available on the worksheet!"
End If
MsgBox Which, vbOKOnly, "DATA ERROR"
Exit Sub
End Sub

Private Sub AddPermutation(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Static Used() As Integer
Dim i As Integer

If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
ReDim Used(1 To iPopSize) As Integer
NextMember = 1
End If

For i = 1 To iPopSize
If Used(i) = 0 Then
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
Used(i) = True
AddPermutation , , NextMember + 1
Used(i) = False
Else
SavePermutation SetMembers()
End If
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
Erase Used
End If

End Sub 'AddPermutation

Private Sub AddCombination(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0, _
Optional NextItem As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Dim i As Integer

If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
NextMember = 1
NextItem = 1
End If

For i = NextItem To iPopSize
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
AddCombination , , NextMember + 1, i + 1
Else
SavePermutation SetMembers()
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
End If

End Sub 'AddCombination

Private Sub SavePermutation(ItemsChosen() As Integer, _
Optional FlushBuffer As Boolean = False)

Dim i As Integer, sValue As String
Static RowNum As Long, ColNum As Long

If RowNum = 0 Then RowNum = 1
If ColNum = 0 Then ColNum = 1

If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
If BufferPtr > 0 Then
If (RowNum + BufferPtr - 1) > Rows.Count Then
RowNum = 1
ColNum = ColNum + 1
If ColNum > 256 Then Exit Sub
End If

Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
= Application.WorksheetFunction.Transpose(Buffer())
RowNum = RowNum + BufferPtr
End If

BufferPtr = 0
If FlushBuffer = True Then
Erase Buffer
RowNum = 0
ColNum = 0
Exit Sub
Else
ReDim Buffer(1 To UBound(Buffer))
End If

End If

'construct the next set
For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Next i

'and save it in the buffer
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid$(sValue, 3)
End Sub 'SavePermutation





A few days back in helping a member of newsgroup I have to find number of occurrence of a particular sub string in a string which is entered in a cell. I tried Google search as well as Mr. excel forum search I was not able to get a satisfactory reference.
So I created a function to solve this problem. I do not know whether
1) this is sufficiently elegant and general function which my peers in the newsgroup approve
2)I hope I am not reinventing the wheel.
3) It will be a useful reference.

If the administrator thinks that this is a not worthwhile post he/she may discard this post. If he/she decides to modify he/she is at liberty to do it.

I am giving the fuction and a example of procedure for using the function.

Code:

Private Function char_nr(r As Range, y As String) As Integer
'this counts number of occasions when a sub string occurs in a string
'r is the range where the string is located
'y is the string whose repeated occurence is couned.
Dim j As Integer, m As Integer, x As String
On Error GoTo outsideloop
x = r.Value
j = 0
m = 1
Do

m = WorksheetFunction.Search(y, x, m)
j = j + 1
m = m + 1
Loop
outsideloop:
char_nr = j
End Function


Code:

Sub test()
'suppose cell A1 contains this string "MC3626, MC3631 MC3681, MC3646"
'and we want to find out how many Ms are in A1.
Dim rng As Range, z As String
Set rng = Range("a1")
z = InputBox("type character or substring to be counted, in this case M")
MsgBox char_nr(rng, z)
End Sub





I have a huge list of car models inventory. About 15,000+ entries in an Excel spreadsheet. I am trying to find out the first letter of the name of the car.

I have the following four formats:
Mercedes CLS 500 (i.e., Name begins with a letter)
2000 Chevrolet Corvette (i.e., 4 numbers + space then the letter)
4x4 Jeep (i.e., number + x + number + space then the letter)
8-Wheel Tipper Truck (i.e., number plus a dash then the letter

It is very easy if the first character is a letter. I used the "Left(a1,1)" command to find the first letter. However, I am not sure how to find the first letter if the first character is a number.

Is there any easier way of find this without going through VBA?

Any help is greatly appreciated.


Hi,
I need a little help here to unhide my sheets.
For now it works fine with just one critiria.

Suppose textbox1 & textbox2 meets critiria then set that row as row and then starting from col 3 do untill cell.value = ""
unhide each sheet depending on = each cell value.


Thanks for helping.
Pedie

PS: Please lemmi know if my question is not explained well enough.
Code:

 Private Sub CommandButton1_Click()
Dim name As String
Dim password As String
Dim Response As Integer
Dim i As Long
'Dim x As String
name = UserForm1.TextBox1.Value
password = UserForm1.TextBox2.Value 
          With Sheets("Home").Range("A1:A17")
          Set c = .Find(name, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
                If c Is Nothing Then
                    Response = MsgBox("The name you entered was not found in the list", _
                    vbCritical + vbRetryCancel, "Name Not Found")
                        Select Case Response
                            Case vbRetry
                                TextBox1.Value = ""
                                TextBox1.SetFocus
                                Exit Sub
                            Case vbCancel
                                Unload Me
                                Exit Sub
                            End Select
                End If
                If Not c Is Nothing Then
                    firstAddress = c.Address
                    Do
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address  firstAddress
                End If
        End With
        If c.Offset(0, 1) = password Then
        x = ActiveCell.Offset(1, 0).Value
        MsgBox "Sucessful..."
        With Sheets("Home")
        x = c.Offset(0, 2).Value
        Sheets(x).Visible = xlSheetVisible
        Sheets(x).Select
        End With
        Unload Me
        Else
        Response = MsgBox("Password does not match", _
                    vbCritical + vbRetryCancel, "Password not Verified...")
                        Select Case Response
                            Case vbRetry
                                TextBox2.Value = ""
                                TextBox2.SetFocus
                                Exit Sub
                            Case vbCancel
                                Unload Me
                                Exit Sub
                            End Select
        End If
End Sub
 





Here's the deal!

I'd like to count how many characters my string contains, but without the use of Len function. To be more precise, I'd like to 'walk' through my string, and increase the counter for every letter I encounter.

So basically, something like this:

Code:

For Each character in string
i = i + 1
Next


The reason why I wan't it done this way is because at a later stage, I will want to insert a letter after the 50th character (for example).

But, it's the end of the day, and my brain is dead.
Help, please.

Cheers,
Ivan.