johnske
11-28-2004, 07:09 PM
AAGH - I give up!...Please - HELP!!! :rolleyes: :bawl
The following subprocedure (between the rows of Xs) works perfectly when copied, pasted and run from inside the target workbook, but bombs out with a select range of class error when run from the other book. :dunno
I've tried every method of selection I can think of, but still cant get it to work properly....(zip file attached if it's any use)
Private Sub CopyAndPaste36Values()
Dim ArchersName$, N%, TestRange As Range
Dim Comment$, Confirmation As VbMsgBoxResult
Dim StartTime, MyRange As Range
Dim Top As Range, Bottom As Range
Application.ScreenUpdating = False
'//ask if user wants to add any comments
Comment = InputBox("Enter any notes or comments below then click OK" & vbLf & _
"" & vbLf & _
"Click OK or Cancel if there are no notes...", "Any Notes To Add?")
'//make a summary on the summary sheet
Summarize36
'//get the archers name
ArchersName = Worksheets("InputSheet").Range("A1")
'//ask user to confirm the details of the entry
Confirmation = MsgBox("Are all these details correct?" & vbLf & _
"(Click No to cancel entry)" & vbLf & _
"" & vbLf & _
"Archers Name: " & ArchersName & vbLf & _
"Date: " & Worksheets("Summary").Range("A19") & vbLf & _
"Round: " & Worksheets("Summary").Range("B19") & vbLf & _
"Distance scores " & Worksheets("Summary").Range("C19") & _
", " & Worksheets("Summary").Range("D19") & _
", " & Worksheets("Summary").Range("E19") & _
", " & Worksheets("Summary").Range("F19") & vbLf & _
"Total: " & Worksheets("Summary").Range("G19") & vbLf & _
"Notes: " & Comment, vbYesNo, "Continue?...")
If Confirmation = vbNo Then
Worksheets("InputSheet").Select
End
End If
'//show message
WaitForm.Show False
'//pause to allow time for the form to activate
StartTime = Timer
Do While Timer < StartTime + 0.01
DoEvents
Loop
'//insert this comment into the temp sheet
Worksheets("36Temp").Range("AZ6") = Comment
'//copy the round details & inserted comment from the temp sheet
Worksheets("36Temp").Range("A6:AZ6").Copy
'//open the archers workbook ("WorkbookIsOpen" is a function)
If WorkbookIsOpen(ArchersName) Then
Workbooks(ArchersName).Activate
Else
Application.Workbooks.Open("C:\Windows\Desktop\" & _
"NewKeeper\DBs\" & ArchersName & ".xls") _
.Activate
End If
'//select the '36' sheet in the archers workbook
With ActiveWorkbook
Worksheets("36TypeRounds").Select
Worksheets("36TypeRounds").Range("A65536") _
.End(xlUp).Offset(1, 0).Select
'//paste the formats and values from the temp sheet
Selection.PasteSpecial Paste:=xlFormats
Selection.PasteSpecial Paste:=xlValues
Run ("Sort36TypeRounds")
'This works perfectly when it's run in the workbook
'//now hide the unused columns (i.e. empty from row 6 down)
With ActiveSheet
For N = 3 To 50
Set Top = Columns(N).Rows(6)
Set Bottom = Columns(N).Rows(65536)
Range(Top, Bottom).Select
On Error Resume Next
Set TestRange = Selection.SpecialCells(xlCellTypeConstants, 23)
If TestRange Is Nothing Then
Columns(N).EntireColumn.Hidden = True
Else
If Not TestRange Is Nothing And Columns(N).EntireColumn.Hidden = True Then
Columns(N).EntireColumn.Hidden = False
End If
End If
Set TestRange = Nothing
Next N
End With
'1004 error with "Range(Top, Bottom).Select" - select method of range class
End With
'//clear the notes from the temp sheet
Workbooks("Keeper").Activate
Worksheets("36Temp").Range("AZ6").ClearContents
'//now get the summary data
Worksheets("Summary").Activate
'//copy the summary
Worksheets("Summary").Range("A19:G19").Copy
'//activate the archers workbook
Workbooks(ArchersName).Activate
With ActiveWorkbook
Worksheets("Summary").Select
Worksheets("Summary").Range("A1") = ArchersName
Worksheets("Summary").Range("A65536") _
.End(xlUp).Offset(1, 0).Select
'//paste the formats and values from the temp sheet
Selection.PasteSpecial Paste:=xlFormats
Selection.PasteSpecial Paste:=xlValues
Run ("SortSummary")
End With
Workbooks("Keeper").Activate
Worksheets("InputSheet").Select
ClearEntries36
Application.ScreenUpdating = True
Unload WaitForm
End Sub
The following subprocedure (between the rows of Xs) works perfectly when copied, pasted and run from inside the target workbook, but bombs out with a select range of class error when run from the other book. :dunno
I've tried every method of selection I can think of, but still cant get it to work properly....(zip file attached if it's any use)
Private Sub CopyAndPaste36Values()
Dim ArchersName$, N%, TestRange As Range
Dim Comment$, Confirmation As VbMsgBoxResult
Dim StartTime, MyRange As Range
Dim Top As Range, Bottom As Range
Application.ScreenUpdating = False
'//ask if user wants to add any comments
Comment = InputBox("Enter any notes or comments below then click OK" & vbLf & _
"" & vbLf & _
"Click OK or Cancel if there are no notes...", "Any Notes To Add?")
'//make a summary on the summary sheet
Summarize36
'//get the archers name
ArchersName = Worksheets("InputSheet").Range("A1")
'//ask user to confirm the details of the entry
Confirmation = MsgBox("Are all these details correct?" & vbLf & _
"(Click No to cancel entry)" & vbLf & _
"" & vbLf & _
"Archers Name: " & ArchersName & vbLf & _
"Date: " & Worksheets("Summary").Range("A19") & vbLf & _
"Round: " & Worksheets("Summary").Range("B19") & vbLf & _
"Distance scores " & Worksheets("Summary").Range("C19") & _
", " & Worksheets("Summary").Range("D19") & _
", " & Worksheets("Summary").Range("E19") & _
", " & Worksheets("Summary").Range("F19") & vbLf & _
"Total: " & Worksheets("Summary").Range("G19") & vbLf & _
"Notes: " & Comment, vbYesNo, "Continue?...")
If Confirmation = vbNo Then
Worksheets("InputSheet").Select
End
End If
'//show message
WaitForm.Show False
'//pause to allow time for the form to activate
StartTime = Timer
Do While Timer < StartTime + 0.01
DoEvents
Loop
'//insert this comment into the temp sheet
Worksheets("36Temp").Range("AZ6") = Comment
'//copy the round details & inserted comment from the temp sheet
Worksheets("36Temp").Range("A6:AZ6").Copy
'//open the archers workbook ("WorkbookIsOpen" is a function)
If WorkbookIsOpen(ArchersName) Then
Workbooks(ArchersName).Activate
Else
Application.Workbooks.Open("C:\Windows\Desktop\" & _
"NewKeeper\DBs\" & ArchersName & ".xls") _
.Activate
End If
'//select the '36' sheet in the archers workbook
With ActiveWorkbook
Worksheets("36TypeRounds").Select
Worksheets("36TypeRounds").Range("A65536") _
.End(xlUp).Offset(1, 0).Select
'//paste the formats and values from the temp sheet
Selection.PasteSpecial Paste:=xlFormats
Selection.PasteSpecial Paste:=xlValues
Run ("Sort36TypeRounds")
'This works perfectly when it's run in the workbook
'//now hide the unused columns (i.e. empty from row 6 down)
With ActiveSheet
For N = 3 To 50
Set Top = Columns(N).Rows(6)
Set Bottom = Columns(N).Rows(65536)
Range(Top, Bottom).Select
On Error Resume Next
Set TestRange = Selection.SpecialCells(xlCellTypeConstants, 23)
If TestRange Is Nothing Then
Columns(N).EntireColumn.Hidden = True
Else
If Not TestRange Is Nothing And Columns(N).EntireColumn.Hidden = True Then
Columns(N).EntireColumn.Hidden = False
End If
End If
Set TestRange = Nothing
Next N
End With
'1004 error with "Range(Top, Bottom).Select" - select method of range class
End With
'//clear the notes from the temp sheet
Workbooks("Keeper").Activate
Worksheets("36Temp").Range("AZ6").ClearContents
'//now get the summary data
Worksheets("Summary").Activate
'//copy the summary
Worksheets("Summary").Range("A19:G19").Copy
'//activate the archers workbook
Workbooks(ArchersName).Activate
With ActiveWorkbook
Worksheets("Summary").Select
Worksheets("Summary").Range("A1") = ArchersName
Worksheets("Summary").Range("A65536") _
.End(xlUp).Offset(1, 0).Select
'//paste the formats and values from the temp sheet
Selection.PasteSpecial Paste:=xlFormats
Selection.PasteSpecial Paste:=xlValues
Run ("SortSummary")
End With
Workbooks("Keeper").Activate
Worksheets("InputSheet").Select
ClearEntries36
Application.ScreenUpdating = True
Unload WaitForm
End Sub