VBA - allow something that almost matches

Z

Zippy

I have a bit of VBA code in an excel spreadsheet macro which checks that all
of the name sheets are present. Now what I would like is if a sheet such as
the last one has been given a capital R in the word routine or the sheet AA
Prime was written as aa prime it would still pass the sheet exists test.

Any clues as how I could do this? My code at present is shown below and it
works OK as long as the sheet names are written exactly as listed in the
array.

TIA.

Zippy


Sheetname = Array("00100", "00200", "00300", "00301", "00040A", "04000",
"00600", "00675", "00650", "05001", "05213", "05005A", "05005B", "05000C",
"33500", "03101", "06179", "06188", "06222G", "18390", "07010C", "07150",
"07200", "07290", "07291", "07400B", "20550", "07555B", "07777", "00400",
"00888", "22471", "30699", "30889", "AA Prime", "Style", "Status", "First
check", "Prime A", "Prime B", "Clean routine")


tabname = 1
Do While tabname < 42
SheetExists = False
For Each ws In Worksheets

If ws.Name = Sheetname(tabname) Then
SheetExists = True

Else
SheetExists = False
GoTo NoSuchSheet
End If
tabname = tabname + 1
Next ws
Loop
NoSuchSheet:
If Not SheetExists Then
Application.ScreenUpdating = True
MsgBox "Sheet " + (Sheetname(tabname)) + " does not exist"
End
Else
End If
 
B

Bob Phillips

sheetname = Array("Prime A", "00100", "00200", "00300", "00301",
"00040A", "04000", _
"00600", "00675", "00650", "05001", "05213", "05005A",
_
"05005B", "05000C", "33500", "03101", "06179",
"06188", _
"06222G", "18390", "07010C", "07150", "07200",
"07290", _
"07291", "07400B", "20550", "07555B", "07777",
"00400", _
"00888", "22471", "30699", "30889", "AA Prime",
"Style", _
"Status", "First check", "Prime A", "Prime B", "Clean
routine")

tabname = LBound(sheetname)
Do While tabname < UBound(sheetname) - LBound(sheetname) + 1

SheetExists = False
For Each ws In Worksheets

If LCase(ws.Name) = LCase(sheetname(tabname)) Then

SheetExists = True
Else

SheetExists = False
GoTo NoSuchSheet
End If

tabname = tabname + 1
Next ws
Loop
NoSuchSheet:
If Not SheetExists Then

Application.ScreenUpdating = True
MsgBox "Sheet " + (sheetname(tabname)) + " does not exist"
End
End If
 
R

Rick Rothstein

Give this code a try...

Dim X As Long, W As Variant, Missing As String
Dim SheetName() As Variant, WS() As Variant
SheetName = Array("00100", "00200", "00300", "00301", "00040A", "04000", _
"00600", "00675", "00650", "05001", "05213", "05005A", _
"05005B", "05000C", "33500", "03101", "06179", "06188", _
"06222G", "18390", "07010C", "07150", "07200", "07290", _
"07291", "07400B", "20550", "07555B", "07777", "00400", _
"00888", "22471", "30699", "30889", "AA Prime", _
"Style", "Status", "First check", "Prime A", _
"Prime B", "Clean routine")
ReDim WS(1 To Sheets.Count)
For X = 1 To Sheets.Count
WS(X) = Sheets(X).Name
Next
For X = LBound(SheetName) To UBound(SheetName)
If UBound(Filter(WS, SheetName(X), , vbTextCompare)) = -1 Then
Missing = Missing & ", " & SheetName(X)
End If
Next
Missing = Mid(Missing, 3)
If Len(Missing) = 0 Then
MsgBox "All names in the SheetName array exist!"
Else
MsgBox "Missing sheets" & vbLf & "===============" & vbLf & Missing
End If
 
Z

Zippy

Thanks Rick,

Unfortunately it appearred to allow names not on the list through and not
tell me about missing ones. However I liked the use of vbTextCompare and
shall bear that in mind for later.

Zippy
 
Z

Zippy

Thanks Bob,

That worked a treat. I'd never have thought of using the LCase function. I
suppose the UCase function would work just as well?

Zippy
 
R

Rick Rothstein

Sorry about that... I misunderstood what you wanted the code to ultimately
do. I see that Bob's code worked for you, so you have your solution.

I did want to emphasize, however, that the vbTextCompare is an optional
argument that can be specified for the Filter function that I used... other
functions allow this type of argument as well (InStr, Split, etc.)... but in
general, it is not a universally available option.
 
Top