Kathtg
asked on
Sheet references removed from metrics when copy is done
I have two workbooks.
- One workbook has the following sheets: Metrics, tester 1, tester 2
- The second workbook has the following sheets: Tester 1, tester 2
The tester works off of the second workbook. Once they have completed adding their information, they hit a copy button and it automatically copies the entire sheet to the first workbook. The sheet name remains the same in both workbooks.
The first workbook has a Metrics tab that contains formulas counting information on the tester 1, and tester 2 tabs. The problem is that when the new sheet is copied in, the references to those sheets in all formulas are removed. Is there a way to stop it from removing these references?
here is the code to the copy button:
Private Sub AutomaticCopy_Click()
Dim docCheckOut As String
Dim CopySheetName As String
Dim CopyFromWorkbookName As String
Dim Msg As String, Ans As Variant
docCheckOut = "https://sharepoint.siriusware.com/Production/testing/4401%20Test%20Assets/Test%20Cases_Trina.xlsm"
CopyToWorkbookName = "Release 4_4_01_01 Test Cases.xlsm"
CopySheetName = ActiveSheet.Name
CopyFromWorkbookName = ActiveWorkbook.Name
Msg = "This will copy the '" & CopySheetName & "' sheet to the '" & CopyToWorkbookName & "' workbook. Are you sure?"
Ans = MsgBox(Msg, vbYesNo)
Application.DisplayAlerts = False
Select Case Ans
Case vbYes
'docCheckOut = Application.InputBox( _
'prompt:="Enter the full location path and name of the SharePoint document to copy the sheet within")
'CopySheetName = Application.InputBox( _
'prompt:="Enter the name of the sheet to be copied")
'CopyFromWorkbookName = Application.InputBox( _
'prompt:="Enter the name of the Workbook to copy the sheet FROM")
'CopyToWorkbookName = Application.InputBox( _
'prompt:="Enter the name of the Workbook to copy the sheet INTO")
'Check Out the Workbook - if not already checked out.
If Workbooks.CanCheckOut(docC heckOut) = True Then
Workbooks.CheckOut docCheckOut
Else
MsgBox "Unable to check out this document at this time. This document is already checked out."
End If
'Now open the workbook that was checked out.
Workbooks.Open Filename:= _
docCheckOut, UpdateLinks:=xlUpdateLinks Always
' Delete the sheet in the new workbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error Resume Next
Sheets(CopySheetName).Dele te
' On Error GoTo 0
' Copy the sheet to the functional area workbook
Windows(CopyFromWorkbookNa me).Activa te
Sheets(CopySheetName).Sele ct
Sheets(CopySheetName).Copy Before:=Workbooks(CopyToWo rkbookName ).Sheets(4 )
'Delete the command button located on the test sheet from the ReleaseTests workbook
ActiveSheet.Shapes.Range(A rray("Auto maticCopy" )).Select
Selection.Delete
ActiveSheet.Shapes.Range(A rray("Gene ricCopy")) .Select
Selection.Delete
'Save and Check In the Workbook
Windows(CopyToWorkbookName ).Activate
ActiveWorkbook.Save
If ActiveWorkbook.CanCheckIn = True Then
ActiveWorkbook.CheckIn
Else
'Save the ReleaseTests workbook and close it
Windows(CopyToWorkbookName ).Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
MsgBox "Unable to check in this document. An error has occurred. Sheet was saved and copied."
End If
MsgBox "The sheet has been successfully saved and copied. Please verify."
Case vbNo
GoTo Quit:
End Select
Quit:
End Sub
- One workbook has the following sheets: Metrics, tester 1, tester 2
- The second workbook has the following sheets: Tester 1, tester 2
The tester works off of the second workbook. Once they have completed adding their information, they hit a copy button and it automatically copies the entire sheet to the first workbook. The sheet name remains the same in both workbooks.
The first workbook has a Metrics tab that contains formulas counting information on the tester 1, and tester 2 tabs. The problem is that when the new sheet is copied in, the references to those sheets in all formulas are removed. Is there a way to stop it from removing these references?
here is the code to the copy button:
Private Sub AutomaticCopy_Click()
Dim docCheckOut As String
Dim CopySheetName As String
Dim CopyFromWorkbookName As String
Dim Msg As String, Ans As Variant
docCheckOut = "https://sharepoint.siriusware.com/Production/testing/4401%20Test%20Assets/Test%20Cases_Trina.xlsm"
CopyToWorkbookName = "Release 4_4_01_01 Test Cases.xlsm"
CopySheetName = ActiveSheet.Name
CopyFromWorkbookName = ActiveWorkbook.Name
Msg = "This will copy the '" & CopySheetName & "' sheet to the '" & CopyToWorkbookName & "' workbook. Are you sure?"
Ans = MsgBox(Msg, vbYesNo)
Application.DisplayAlerts = False
Select Case Ans
Case vbYes
'docCheckOut = Application.InputBox( _
'prompt:="Enter the full location path and name of the SharePoint document to copy the sheet within")
'CopySheetName = Application.InputBox( _
'prompt:="Enter the name of the sheet to be copied")
'CopyFromWorkbookName = Application.InputBox( _
'prompt:="Enter the name of the Workbook to copy the sheet FROM")
'CopyToWorkbookName = Application.InputBox( _
'prompt:="Enter the name of the Workbook to copy the sheet INTO")
'Check Out the Workbook - if not already checked out.
If Workbooks.CanCheckOut(docC
Workbooks.CheckOut docCheckOut
Else
MsgBox "Unable to check out this document at this time. This document is already checked out."
End If
'Now open the workbook that was checked out.
Workbooks.Open Filename:= _
docCheckOut, UpdateLinks:=xlUpdateLinks
' Delete the sheet in the new workbook
Application.DisplayAlerts = False
Application.ScreenUpdating
On Error Resume Next
Sheets(CopySheetName).Dele
' On Error GoTo 0
' Copy the sheet to the functional area workbook
Windows(CopyFromWorkbookNa
Sheets(CopySheetName).Sele
Sheets(CopySheetName).Copy
'Delete the command button located on the test sheet from the ReleaseTests workbook
ActiveSheet.Shapes.Range(A
Selection.Delete
ActiveSheet.Shapes.Range(A
Selection.Delete
'Save and Check In the Workbook
Windows(CopyToWorkbookName
ActiveWorkbook.Save
If ActiveWorkbook.CanCheckIn = True Then
ActiveWorkbook.CheckIn
Else
'Save the ReleaseTests workbook and close it
Windows(CopyToWorkbookName
ActiveWorkbook.Save
ActiveWorkbook.Close
MsgBox "Unable to check in this document. An error has occurred. Sheet was saved and copied."
End If
MsgBox "The sheet has been successfully saved and copied. Please verify."
Case vbNo
GoTo Quit:
End Select
Quit:
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Ok, I have no idea how to do that suggestion. I've decided to try and change this function into a Countifs to use my formula instead:
Function myCountIf(rng As Range, criteria) As Long
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Metrics" And ws.Name <> "TFSData" Then
myCountIf = myCountIf + WorksheetFunction.CountIf( ws.Range(r ng.Address ), criteria)
End If
Next ws
End Function
It is likely a cleaner way to do it. I tried changing the myCountIf line to:
myCountIfs = myCountIfs + WorksheetFunction.CountIfs (ws.Range( rng.Addres s), criteria, ws.Range(rng.Address), criteria)
but it doesn't work. Anyone know what is wrong with it? This function will loop through every sheet except TFSData and Metrics.
Function myCountIf(rng As Range, criteria) As Long
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Metrics" And ws.Name <> "TFSData" Then
myCountIf = myCountIf + WorksheetFunction.CountIf(
End If
Next ws
End Function
It is likely a cleaner way to do it. I tried changing the myCountIf line to:
myCountIfs = myCountIfs + WorksheetFunction.CountIfs
but it doesn't work. Anyone know what is wrong with it? This function will loop through every sheet except TFSData and Metrics.
ASKER
I couldn't figure this one out so I decided to change the formulas instead - turns out this seems to be a better idea as it will make the formulas dynamic and not sheet dependent
ASKER
I'm sure the solution was correct but I needed to understand more than the one sentence telling me the action to take to execute. I didn't adopt that solution because I couldn't figure it out. I went another direction.
ASKER
Sheets(CopySheetName).Dele
I'll remove it and only copy, and look for a replace command instead