problem with macro - its case sensitive! - help please

[mike]

Hi all,

I have the following macro that allows the user to input a country name
(sheet name) and company name to search and produce a report or msgbox.
The problem is that the macro is case sensitive...
ie. it will only work if the user enters exactly the names exactly as they
appear.

Therefore is is possible to edit the macro to search for the inputs
regardless of case and maybe for similar spelling?

Thanks in advance..

mike

Code follows:

Sub instreport()


' state the dimensions and variables
Dim oldsheet As String
Dim i As Integer
Dim SheetName As String
'r2 and r6 are public variables

Dim xcountry As String 'the country you wish to search
Dim xinst As String 'the institution type you wish to search for
Dim today 'today's date to be included in the report

Dim Newsh As Worksheet
Dim Basebook As Workbook



'if the user clicks cancels exit the macro
macrostart = MsgBox(startprompt, startbutton, starttitle)
If macrostart = vbCancel Then
Exit Sub
Else


'inputbox for country
iprompt1 = "Please enter the name of the country to search." & vbNewLine &
vbNewLine & "Please note that your entry must match the available country
tabs and is CASE sensitive."
ititle1 = filename + "\Report Creation Tool"
xcountry = InputBox(iprompt1, ititle1)

'inputbox for institution type - currently only three options available
iprompt2 = "Please enter the institution type to search." & vbNewLine &
vbNewLine & "Current categories are:" & vbNewLine & "Bank" & vbNewLine &
"Broker" & vbNewLine & "Other" & vbNewLine & "Please note that entries are
CASE sensitive."
ititle2 = filename + "\Report Creation Tool"
xinst = InputBox(iprompt2, ititle2)

'confirm that selection is correct and continue
mPrompt1 = "Please confirm that you wish to create the following report... "
& vbNewLine & "Institution type: " + xinst & vbNewLine & "Country: " +
xcountry & vbNewLine & vbNewLine & "Your report will be created and placed
before the Front Page."
mbutton1 = vbYesNo + vbQuestion
mTitle1 = filename + "\Report Creation Tool"
repconf = MsgBox(mPrompt1, mbutton1, mTitle1) 'confirm details before
writing report.


If repconf = vbYes Then 'if the user clicks yes, the macro continues


SheetName = xinst + " Report, " + xcountry 'name of the new sheet based on
input

On Error GoTo CreateNewSheet
Sheets(SheetName).Activate
xsubprompt = "The report you have requested already exists." & vbNewLine
& "The active sheet is now: " & vbNewLine & SheetName
xsubbutton = vbOKOnly + vbExclamation
xsubtitle = filename + "\Report Creation Tool"
xsub = MsgBox(xsubprompt, xsubbutton, xsubtitle)
Exit Sub
CreateNewSheet:
Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add
Newsh.Name = SheetName

ThisWorkbook.Sheets(SheetName).Tab.ColorIndex = 45

Sheets(SheetName).Activate
Range("A1").Value = Date
Range("A2").Value = SheetName
Range("A4").Value = "Company Name"
Range("B4").Value = "Function1"

Call formatreport

Application.ScreenUpdating = False

i = 0
Sheets(xcountry).Activate
Range("d3").Select
If ActiveCell <> "" Then
Do Until ActiveCell = ""
If ActiveCell = xinst Then
c2 = ActiveCell.Offset(0, -2)
c5 = ActiveCell.Offset(0, 1)
c6 = ActiveCell.Offset(0, 2)
c10 = ActiveCell.Offset(0, 6)
c12 = ActiveCell.Offset(0, 8)
c13 = ActiveCell.Offset(0, 9)
c16 = ActiveCell.Offset(0, 12)
c17 = ActiveCell.Offset(0, 13)
c23 = ActiveCell.Offset(0, 19)
c21 = ActiveCell.Offset(0, 18)
c24 = ActiveCell.Offset(0, 20)
c26 = ActiveCell.Offset(0, 22)
c27 = ActiveCell.Offset(0, 23)
c30 = ActiveCell.Offset(0, 26)

i = i + 1
Call PasteMeHere(xcountry, i, SheetName)
End If
ActiveCell.Offset(1, 0).Select
Loop

Sheets(SheetName).Activate
Columns("A:N").Select
Selection.Columns.AutoFit

finishtool = MsgBox(endprompt, endbutton, endtitle)


End If
Else: Exit Sub
End If
End If


Application.ScreenUpdating = True
End Sub

 

[papou]

Hello Mike
What are the matching restrictions?
(think about LCASE an UCASE and Application.Proper functions)
I would also suggest that you use the Application.Inputbox method (instead
of the Inputbox function) which will allow for better control of the users'
input.
In your case, you are expecting text input then:
xcountry = Application.InputBox(iprompt1, ititle1, , , , , , 2)
xinst = Application.InputBox(iprompt2, ititle2, , , , , , 2)

Apart from these little suggestions, you could use an intermediate function
to check for the existing worksheet:
Function SheetExists(strShName As String) As Boolean
On Error Resume Next
SheetExists = Sheets(strShName).Name <> ""
Err.Clear
On Error Goto 0
End Function

HTH
Cordially
Pascal

 

[Peter T]

I haven't looked at your macro but here are a couple of ways to compare text
insensitive to case -

bSame = UCase(StringA) = UCase(StringB)
could use LCase()

you can head your module (the one with code doing sting comparisons) like
this

Option Compare Text

(Some purists prefer not to use Option Compare)

Regards,
Peter T

 

[mike]

Dear Both,

Thanks for your reply.
I have looked at the UCase/LCase, but is there a way to only capitalise the
first letter? Otherwise it looks like i have to convert everything in the
workbook to either Uppercase OR Lowercase.

Also, any suggestions how to match on similar entries, i.e. if the user make
a spelling mistake?

Thanks

mike

 

[papou]

Mike

but is there a way to only capitalise the
first letter?

Yes, I suggested it in my first reply, it's Application.Proper
As regards checking spelling mistakes, I could hardly help you achieve this.
But if the match entries correspond to worksheet names (as it seems from
your post), why not use the little function I provided?
There could be another much simpler alternative:
Provide users with a list of available names and let them select the
required name from the list.

HTH
Cordially
Pascal

 

[Peter T]

I don't see why you need to change anything in your worksheet if you are,
say, comparing UCase with UCase in code, but if you really think you need to
capitalise first letter -

Sub test3()
Dim s As String
Dim sProper As String, sFirstCap As String

s = "aBc dEf"

sProper = Application.WorksheetFunction.Proper(s)
Debug.Print sProper 'Abc Def

sFirstCap = UCase(Left(s, 1)) & LCase(Mid(s, 2, Len(s)))
Debug.Print sFirstCap 'Abc def

End Sub


Spelling mistakes - there are functions around that aim to score similarity
in text comparisons, try a search of
Levenshtein, possibly with Ratcliff & Obershelp and "distance".

Problem comes in interpreting the score as to what constitutes a potential
spelling mistake.

Regards,
Peter T

 

[mike]

Papou,

Thanks for your reply.
I'm sorry I misunderstood your previous post.

Where would I place application.proper and UCase/LCase in my current macro?
After the inputbox entry?

Thanks
mike

 

[mike]

I didn't explain very well...
The Workbook currently contains worksheets that are named as countries, ie.
Country (First letter is capitalisted unless the name is abbreviated eg. USA)
Within Column B is a company name and this is also entered as Company (with
the first letter capitalised).
I understood from the your post that I could only change to UCase or LCase.
Thanks for your suggestions regarding spelling...

mike

 

[papou]

Mike

SheetName = Application.Proper(xinst + " Report, " + xcountry) 'name of
the new sheet based

But I don't see the point because sheet names are NOT case sensitive?

If you use the little function I provided then your could go on in your code
like this:

If Not SheetExists(SheetName) Then
Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add
Newsh.Name = SheetName
Else
xsubprompt = "The report you have requested already exists." & vbNewLine &
"The active sheet is now: " & vbNewLine & SheetName
xsubbutton = vbOKOnly + vbExclamation
xsubtitle = filename + "\Report Creation Tool"
xsub = MsgBox(xsubprompt, xsubbutton, xsubtitle)
end if

ThisWorkbook.Sheets(SheetName).Tab.ColorIndex = 45
Sheets(SheetName).Activate
Range("A1").Value = Date
Range("A2").Value = SheetName
Range("A4").Value = "Company Name"
Range("B4").Value = "Function1"
Call formatreport
Application.ScreenUpdating = False
i = 0
Sheets(xcountry).Activate
Range("d3").Select
If ActiveCell <> "" Then
Do Until ActiveCell = ""
If ActiveCell = xinst Then
c2 = ActiveCell.Offset(0, -2)
c5 = ActiveCell.Offset(0, 1)
c6 = ActiveCell.Offset(0, 2)
c10 = ActiveCell.Offset(0, 6)
c12 = ActiveCell.Offset(0, 8)
c13 = ActiveCell.Offset(0, 9)
c16 = ActiveCell.Offset(0, 12)
c17 = ActiveCell.Offset(0, 13)
c23 = ActiveCell.Offset(0, 19)
c21 = ActiveCell.Offset(0, 18)
c24 = ActiveCell.Offset(0, 20)
c26 = ActiveCell.Offset(0, 22)
c27 = ActiveCell.Offset(0, 23)
c30 = ActiveCell.Offset(0, 26)
i = i + 1
Call PasteMeHere(xcountry, i, SheetName)
End If
ActiveCell.Offset(1, 0).Select
Loop
Sheets(SheetName).Activate
Columns("A:N").Select
Selection.Columns.AutoFit
finishtool = MsgBox(endprompt, endbutton, endtitle)
End If
Else: Exit Sub
End If
End If
Application.ScreenUpdating = True
End Sub



Function SheetExists(strShName As String) As Boolean
On Error Resume Next
SheetExists = Sheets(strShName).Name <> ""
Err.Clear
On Error Goto 0
End Function


HTH
Cordially
Pascal