Function isCapital(tempLetter As String)
' function to see if current char is a capital
Dim CapLetter As Boolean
CapLetter = False
If Asc(tempLetter) > 64 And Asc(tempLetter) < 91 Then
CapLetter = True
End If
isCapital = CapLetter
End Function
' ---------------------------------------------------------
Sub SplitWords()
Dim isCap As Boolean
Dim addWord As Boolean
Dim newList()
Dim letPos As Integer
Dim thisChar As String
Dim nextChar As String
Dim prevChar As String
Dim mainWord As String
Dim skip As Boolean
Dim wordCounter As Integer
Dim z As Integer
Dim counter As Integer
Dim wordLen As Integer
Dim off As Integer
Dim leftString As String
Dim rightString As String
ReDim newList(1)
' Select th cell where your data starts
Range("A1").Select
' select all contiguous cell around that cell
Selection.CurrentRegion.Select
wordCounter = 0
' work through each selected cell
For Each cell In Selection
mainWord = cell.Value
mainWord = mainWord & "X" ' add X to end of main word reason as below
wordLen = Len(mainWord)
letPos = 2 'start from 2 because we need to refer to previous
cell
Do While letPos < wordLen
skip = False
' read this , previous and next charcaters
thisChar = Mid(mainWord, letPos, 1)
nextChar = Mid(mainWord, letPos + 1, 1)
prevChar = Mid(mainWord, letPos - 1, 1)
leftString = Left(mainWord, letPos)
rightString = Mid(mainWord, letPos + 1)
' if this char is a "_" just skip to next char
If thisChar = "_" Then
skip = True
End If
' only if this char <> "_"
' make a few comparisons
If skip = False Then
If Not isCapital(thisChar) And isCapital(nextChar) Then
mainWord = leftString & "$" & rightString
letPos = letPos + 1
End If
If isCapital(prevChar) And isCapital(thisChar) Then
If Not isCapital(nextChar) And nextChar <> "_" Then
leftString = Left(mainWord, letPos - 1)
rightString = Mid(mainWord, letPos)
mainWord = leftString & "$" & rightString
letPos = letPos + 1
End If
End If
End If
' beacuse we have added to the mainword ie $ sign to
' mark end of word, need to cal length of main word again
wordLen = Len(mainWord)
letPos = letPos + 1
Loop
mainWord = Left(mainWord, Len(mainWord) - 1)
' look for end of word and place into array
Do While Len(mainWord) > 1
z = InStr(mainWord, "$")
If z > 0 Then
thisWord = Left(mainWord, z - 1)
mainWord = Mid(mainWord, z + 1)
End If
addWord = True
For counter = 1 To UBound(newList) ' up to the highes element number of
array
If newList(counter) = thisWord Then
addWord = False 'if current word already in array then ignore it
End If
Next
If addWord And thisWord <> "" Then
' if not already in array
' then resize the array and add word
wordCounter = wordCounter + 1
ReDim Preserve newList(wordCounter)
newList(wordCounter) = thisWord
End If
Loop
Next cell
Stop
' now the words are in the array, write them to spreadsheet
' I have chosen cell A13. You can change to whatever you need
Range("A13").Select
' select cells equalling the number of elements in array
off = 1
Do While off <= UBound(newList)
Selection.Offset(off, 0) = newList(off)
off = off + 1
Loop
End Sub
[Code Ends]
Cheers
Chas
[QUOTE="spartacus13210"]
Hi Chas,
Firstly, thanks for taking the time out to look at my problem. Secondly, to
answer your question:
Yes, a new word will always start with a capital letter and will not start
with a number--but, it might end with a number. However, there might be
instances (which i forgot to include in my original post), where a word might
be like--"PatientAlternateIDDBKey." In such a case, i hope that the code can
break down "PatientAlternateIDDBKey" as:
Patient
Alternate
IDDB
Key
Also, there might be a case where the word might be
"HEALTH_REGISTRATION_ID," in such a case i hope the code can insert this word
"as is." Such a word need not be split up.
Thanks in advance for the effort.
[/QUOTE][/QUOTE]
