Option Explicit
Sub Start()
frmSearch.Show vbModeless
End Sub
Public Sub AutoFit()
Range("A:E").EntireColumn.AutoFit
Range("A:A").EntireRow.AutoFit
Range("A2").Select
End Sub
Sub Sort()
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("B:B").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("C:C").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("D:D").Select
Selection.Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("E:E").Select
Selection.Sort Key1:=Range("E1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Call AutoFit
End Sub
Sub condFormat()
''check the number of letters in cell and turns red if number not eqaul to
Dim rg, rg2, rg3, rg4, rg5 As Range
Dim cond As FormatCondition, cond2 As FormatCondition, cond3 As FormatCondition, cond4 As FormatCondition, cond5 As FormatCondition
Set rg = Range("A2", Range("A2").End(xlDown))
Set rg2 = Range("B2", Range("B2").End(xlDown))
Set rg3 = Range("C2", Range("C2").End(xlDown))
Set rg4 = Range("D2", Range("D2").End(xlDown))
Set rg5 = Range("E2", Range("E2").End(xlDown))
Application.ScreenUpdating = False
'clear any existing conditional formatting
rg.FormatConditions.Delete
rg2.FormatConditions.Delete
rg3.FormatConditions.Delete
rg4.FormatConditions.Delete
rg5.FormatConditions.Delete
'define the rule for each conditional format
'3 letters
Set cond = rg.FormatConditions.Add(xlExpression, xlNotEqual, Formula1:="=LEN(A2)=3")
Set cond = rg.FormatConditions.Add(xlNoBlanksCondition)
'4 letters
Set cond2 = rg2.FormatConditions.Add(xlExpression, xlNotEqual, Formula1:="=LEN(B2)=4")
Set cond2 = rg2.FormatConditions.Add(xlNoBlanksCondition)
'5 letters
Set cond3 = rg3.FormatConditions.Add(xlExpression, xlNotEqual, Formula1:="=LEN(C2)=5")
Set cond3 = rg3.FormatConditions.Add(xlNoBlanksCondition)
'6 letters
Set cond4 = rg4.FormatConditions.Add(xlExpression, xlNotEqual, Formula1:="=LEN(D2)=6")
Set cond4 = rg4.FormatConditions.Add(xlNoBlanksCondition)
'7 letters
Set cond5 = rg5.FormatConditions.Add(xlExpression, xlNotEqual, Formula1:="=LEN(E2)=7")
Set cond5 = rg5.FormatConditions.Add(xlNoBlanksCondition)
'define the format applied for each conditional format
With cond
.Interior.Color = vbRed
.Font.Color = vbBlack
End With
With cond2
.Interior.Color = vbRed
.Font.Color = vbBlack
End With
With cond3
.Interior.Color = vbRed
.Font.Color = vbBlack
End With
With cond4
.Interior.Color = vbRed
.Font.Color = vbBlack
End With
With cond5
.Interior.Color = vbRed
.Font.Color = vbBlack
End With
Application.ScreenUpdating = True
End Sub
' If the word being tested is shorter than search string, then match if all letter in word being tested are in the search string
' If word being tested is same length as search string, then match if word is exact anagram of search string
' If word being tested is longer than search string, then match if all letters in search string are in word being tested
' Character order and proximity are not evaluated
Public Function partmatch(ByVal strTest As String, ByVal strSearch As String) As Boolean
Dim lp As Long
Dim keep As Long
keep = Len(strTest)
If Len(strTest) > 0 And Len(strSearch) > 0 Then
' Remove any matching characters that are in the testing string.
For lp = 1 To Len(strSearch)
strTest = Replace(strTest, Mid$(strSearch, lp, 1), "", , 1)
Next
partmatch = (keep - Len(strSearch) = Len(strTest)) Or Len(strTest) = 0 ' did we match all the characters?
End If
End Function
![[ponder]](/data/assets/smilies/ponder.gif "[ponder] [ponder]")
![[wiggle]](/data/assets/smilies/wiggle.gif "[wiggle] [wiggle]")
