View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Mike Mike is offline
external usenet poster
 
Posts: 3,101
Default copy selected cells to new sheet.

Hi JR,
Thanks for your reply.

I would use a user form but I'm not familar with forms in Excel or Access
for that matter.
The problem now is copying the selected cells to the new sheet.
Any suggestions would be greatly appreciated,

Cheers,

mike

"JRForm" wrote:

Mike,

If your workbook tab are the list of countries available why not use a form
and a list box? You could use a combo box for the institutiion for example:

Dim WrkSht As Long
Dim i As Long
WrkSht = Sheets.Count
For i = 1 To WrkSht
Me.ListBox1.AddItem Sheets(i).Name
Me.ComboBox1.AddItem "Institution " & i
Next i

Your user can choose the country then institution and click a command button
to run your code that creates the new sheet.

"mike" wrote:

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