M
mike
Hi everybody, following on from my previous post that JRForm was kind enough
to answer, I have another problem.
Target: my workbook contains lots of sheets that are named by country. I
would like a macro to ask the user which country they want to search and what
instiution type, then create a new sheet and paste information from specific
cells there.
Ie. User activates workbook, clicks button, macro runs... types country,
types institution. the macro runs and creates a new sheet called "institution
report, country". This sheet is filled in column b with the name of the
company which has been taken from row 2 of the country sheet and column c
with the insitution, which is the row which the macro will search - row 4,
plus column d will be any comments which appear in row 6.
I have to far got my code to ask for the country and institution, check for
exising sheets and create a new sheet putting the date in a1.
But now I'm confused and don't know the best way to continue.
Looking forward to your replies, thanks in advance,
mike
CODE:
sub mikescode()
this code should ask which country you are searching for, then ask what
report you wish to create,
'ie. which institutions, and then search the relevant country sheet and copy
the name and institution type plus comment
'to a new sheet called _country_institution_ Report, the report should
include the date and automatically open
'the print dialog box to print to the local printer.
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 r2 'this is row 2
Dim r6 'this is row 6
Dim SheetName As String
Dim TestSht As Object
Dim OkToAdd As Boolean
Dim resp As Long
Dim wks As Worksheet
Dim oldreport As String
iprompt1 = "Please enter the name of the country to search."
ititle1 = "xcountry"
xcountry = InputBox(iprompt1, ititle2)
iprompt2 = "Please enter the institution type to search."
ititle2 = "xtype"
xinst = InputBox(iprompt2, ititle2)
mPrompt1 = "Please confirm that you wish to create a " + xinst + " report
for " + xcountry
mbutton1 = vbYesNo + vbQuestion
mTitle1 = "Confirm Report details"
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
OkToAdd = False
If SheetExists(SheetName) = False Then
OkToAdd = True
Else
'match upper/lower case of existing sheet name
SheetName = Sheets(SheetName).Name
oldreport = Range("a1")
resp = MsgBox("That report was created on " & oldreport & _
vbLf & "Do you wish to create a second report?",
Buttons:=vbOKCancel + vbCritical, Title:="Duplicate reports")
If resp = vbCancel Then
Exit Sub
Else: resp = vbOK
OkToAdd = True
End If
End If
If OkToAdd = True Then
Set wks = Worksheets.Add
Call GiveItANiceName(SheetName, wks)
Range("A1").Value = Date
End If
Sheets(xcountry).Activate
Range("E4:AQ4").Select
If ActiveCell <> xinst Then
Do Until ActiveCell = xinst
If ActiveCell = xinst Then
r2 = ActiveCell.Offset(-2, 0)
r6 = ActiveCell.Offset(2, 0)
End If
ActiveCell.Offset(0, 1).Select
Loop
End If
End If
End Sub
Function SheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
SheetExists = CBool(Len(WB.Sheets(SheetName).Name) > 0)
End Function
Sub GiveItANiceName(myPFX As String, wks As Worksheet) 'dave peterson
Dim iCtr As Long
Dim mySFX As String
Dim myStr As String
Do
If iCtr = 0 Then
myStr = ""
Else
myStr = " (" & iCtr & ")"
End If
On Error Resume Next
wks.Name = myPFX & mySFX & myStr
If Err.Number <> 0 Then
Err.Clear
Else
Exit Do
End If
On Error GoTo 0
iCtr = iCtr + 1
Loop
End Sub 'dave peterson wrote this code
to answer, I have another problem.
Target: my workbook contains lots of sheets that are named by country. I
would like a macro to ask the user which country they want to search and what
instiution type, then create a new sheet and paste information from specific
cells there.
Ie. User activates workbook, clicks button, macro runs... types country,
types institution. the macro runs and creates a new sheet called "institution
report, country". This sheet is filled in column b with the name of the
company which has been taken from row 2 of the country sheet and column c
with the insitution, which is the row which the macro will search - row 4,
plus column d will be any comments which appear in row 6.
I have to far got my code to ask for the country and institution, check for
exising sheets and create a new sheet putting the date in a1.
But now I'm confused and don't know the best way to continue.
Looking forward to your replies, thanks in advance,
mike
CODE:
sub mikescode()
this code should ask which country you are searching for, then ask what
report you wish to create,
'ie. which institutions, and then search the relevant country sheet and copy
the name and institution type plus comment
'to a new sheet called _country_institution_ Report, the report should
include the date and automatically open
'the print dialog box to print to the local printer.
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 r2 'this is row 2
Dim r6 'this is row 6
Dim SheetName As String
Dim TestSht As Object
Dim OkToAdd As Boolean
Dim resp As Long
Dim wks As Worksheet
Dim oldreport As String
iprompt1 = "Please enter the name of the country to search."
ititle1 = "xcountry"
xcountry = InputBox(iprompt1, ititle2)
iprompt2 = "Please enter the institution type to search."
ititle2 = "xtype"
xinst = InputBox(iprompt2, ititle2)
mPrompt1 = "Please confirm that you wish to create a " + xinst + " report
for " + xcountry
mbutton1 = vbYesNo + vbQuestion
mTitle1 = "Confirm Report details"
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
OkToAdd = False
If SheetExists(SheetName) = False Then
OkToAdd = True
Else
'match upper/lower case of existing sheet name
SheetName = Sheets(SheetName).Name
oldreport = Range("a1")
resp = MsgBox("That report was created on " & oldreport & _
vbLf & "Do you wish to create a second report?",
Buttons:=vbOKCancel + vbCritical, Title:="Duplicate reports")
If resp = vbCancel Then
Exit Sub
Else: resp = vbOK
OkToAdd = True
End If
End If
If OkToAdd = True Then
Set wks = Worksheets.Add
Call GiveItANiceName(SheetName, wks)
Range("A1").Value = Date
End If
Sheets(xcountry).Activate
Range("E4:AQ4").Select
If ActiveCell <> xinst Then
Do Until ActiveCell = xinst
If ActiveCell = xinst Then
r2 = ActiveCell.Offset(-2, 0)
r6 = ActiveCell.Offset(2, 0)
End If
ActiveCell.Offset(0, 1).Select
Loop
End If
End If
End Sub
Function SheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
SheetExists = CBool(Len(WB.Sheets(SheetName).Name) > 0)
End Function
Sub GiveItANiceName(myPFX As String, wks As Worksheet) 'dave peterson
Dim iCtr As Long
Dim mySFX As String
Dim myStr As String
Do
If iCtr = 0 Then
myStr = ""
Else
myStr = " (" & iCtr & ")"
End If
On Error Resume Next
wks.Name = myPFX & mySFX & myStr
If Err.Number <> 0 Then
Err.Clear
Else
Exit Do
End If
On Error GoTo 0
iCtr = iCtr + 1
Loop
End Sub 'dave peterson wrote this code