Option Explicit
Function CompareTruncate(ByVal string1 As String, ByVal _
String2 As String)
'Ajay Askoolum, 2003-01-09, http://google.com/groups?threadm=uSVa6U%24tCHA.1668%40TK2MSFTNGP09
string1 = Left(string1 & " ", InStr(InStr(string1 & " ", " ") + 1, _
string1 & " ", " "))
String2 = Left(String2 & " ", InStr(InStr(String2 & " ", " ") + 1, _
String2 & " ", " "))
'-- CompareTruncate = UCase(string1) = UCase(String2)
CompareTruncate = InStr(1, String2, string1, vbTextCompare) = 1
End Function
Sub TextHighLighter()
'DMcRitchie 2002-08-19
' strings in column A
' word numbers in Column B to be highlighted
' | A computer bug is ...| 2 3 | A computer bug is ...|
Dim cell As Range
Dim word As String, I As Long
Dim oldstr As String, newStr As String
Dim wordCnt As Long
For Each cell In Range("A1:A42")
oldstr = cell.Value
newStr = ""
wordCnt = 0
nextword:
I = InStr(1, oldstr, " ", 0)
If I = 0 Then
newStr = newStr & " " & oldstr
GoTo NextCell
End If
wordCnt = wordCnt + 1
word = Left(oldstr, I - 1)
oldstr = Mid(oldstr, I + 1)
I = InStr(1, " " & cell.Offset(0, 1) & " ", wordCnt)
If I > 0 Then
newStr = newStr & " " & word & ""
Else
newStr = newStr & " " & word
End If
GoTo nextword
NextCell:
newStr = Replace(newStr, " ", " ")
cell.Offset(0, 3) = "
" & Mid(newStr, 2)
Next cell
End Sub
Sub Format_with_hyphen(Optional formatSTR As String)
'-- The parameter here can only be used if invoked from another macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim I As Long, j As Long, result As String
Dim cell As Range, newStr As String, tstLen As Long
On Error Resume Next 'In case no cells in selection
If formatSTR = "" Then
newStr = "Hxxx-xxx-xx-xxx-x"
Else
newStr = formatSTR
End If
tstLen = Len(Replace(newStr, "-", ""))
For Each cell In Intersect(Selection, ActiveSheet.UsedRange)
If Len(cell.Text) = tstLen Then
j = 1
result = ""
For I = 1 To Len(newStr)
If Mid(newStr, I, 1) = "-" Then
result = result & "-"
Else
result = result & Mid(cell.Text, j, 1)
j = j + 1
End If
Next I
cell.Value = "'" & result
End If
Next cell
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Function hexit(str As String) As String
Dim I As Long 'renamed from Ron Rosenfeld's WEPConv, excel, 2005-04-26
For I = 1 To Len(str)
hexit = hexit & Hex(Asc(Mid(str, I, 1)))
Next I
End Function
Function dehex(str As String) As String
Dim I As Long 'David McRitchie, strings.htm, 2005-04-26
For I = 1 To Len(str) Step 2
dehex = dehex & Chr( _
InStr(1, "0123456789ABCDEF", Mid(str, I, 1)) * 16 - 16 _
+ InStr(1, "0123456789ABCDEF", Mid(str, I + 1, 1)) - 1)
Next I
End Function