K
Karen53
Hi,
I have two open workbooks. I am using GetOpenFilename to open the second
workbook.
When procedure finishes, excel askes if I want to save the changes to
wbkCopyFrom, I say no. It then gives me an warning message that wbkCopyTo
already exists. WbkCopyTo is the workbook that opened wkbCopyFrom. Is there
a way to eliminate this message and just save the file? It's treating CopyTo
like it's a new file when it actually is not.
Sub GetTenantInfo()
Dim wbkCopyFrom As Workbook
Dim wbkCopyTo As Workbook
Dim ws As Worksheet
Dim TenRow As Long
Dim TenantType As String
Dim TenantName As String
Dim PrimaryUnitNo As Long
Dim ShName As String
Dim wkbName As String
Dim FromLusedRow As Long
Dim NewLusedRow As Long
Dim AfterShName As String
Dim ShNumber As Long
Dim iCtr As Long
Dim Start As Long
Dim FromwbkPath
FromwbkPath = Application.GetOpenFilename
Set wbkCopyTo = ThisWorkbook
On Error Resume Next
Set wbkCopyFrom = Workbooks(FromwbkPath)
If wbkCopyFrom Is Nothing Then
Set wbkCopyFrom = Workbooks.Open(FromwbkPath)
On Error GoTo 0
If wbkCopyFrom Is Nothing Then
MsgBox "Cannot find originating file"
Else
Set ws = wbkCopyFrom.Sheets((Replace(MainPagepg.Name, "'", "''")))
'get the last tenant's row in the From workbook
FromLusedRow = ws.Cells(Rows.Count, "F").End(xlUp).Row
'get the last tenant's row in the New workbook
NewLusedRow = MainPagepg.Cells(Rows.Count, "F").End(xlUp).Row
If NewLusedRow < 14 Then
TenRow = 14
Else
TenRow = NewLusedRow + 1
End If
Start = TenRow
For iCtr = Start To FromLusedRow
With ws
'get values from old workbook
ShName = .Cells(iCtr, 56).Value
TenantType = .Cells(iCtr, 3).Value
TenantName = .Cells(iCtr, 6).Value
PrimaryUnitNo = .Cells(iCtr, 4).Value
End With
Application.StatusBar = "Processing. Please Wait."
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
wbkCopyTo.Activate
Call AddSheets.UnProtectSht(Replace(MainPagepg.Name, "'", "''"))
'insert new tenant's row
MainPagepg.Rows(iCtr).Insert (xlDown)
Call AddSheets.ProtectSht(Replace(MainPagepg.Name, "'", "''"))
Call NuSaveTenantName(iCtr, TenantName)
Call NuSaveTenantType(iCtr, TenantType)
Call NuSavePrimaryUnitNo(iCtr, PrimaryUnitNo)
'check if this is the first tenant sheet
If MainPagepg.Range("BD" & iCtr - 1) = "" Then
ShNumber = Firstpg.Index
Else 'get the name of the sheet before new tenant
AfterShName = MainPagepg.Range("BD" & iCtr - 1).Value
ShNumber = Sheets(AfterShName).Index
End If
'copy the sheet
Call AddSheets.UnProtectWkbook
CAMMaster.Copy After:=Sheets(ShNumber)
'name the sheet
ActiveSheet.Name = (ShName)
Call ProtectSht(ShName)
Call AddSheets.ProtectWkbook
'add links from new sheet to Master page
Call AddSheets.AddNameMain(ShName, iCtr)
'add links & formulas to new sheet from main page
Debug.Print "AddSheet call AddFormulaLinks " & _
Application.ScreenUpdating
Call AddSheets.AddFormulaLinks(ShName, iCtr)
Call CopyTenantSheetFields(ShName, wbkCopyFrom)
Next
End If
End If
wbkCopyFrom.Close
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
I have two open workbooks. I am using GetOpenFilename to open the second
workbook.
When procedure finishes, excel askes if I want to save the changes to
wbkCopyFrom, I say no. It then gives me an warning message that wbkCopyTo
already exists. WbkCopyTo is the workbook that opened wkbCopyFrom. Is there
a way to eliminate this message and just save the file? It's treating CopyTo
like it's a new file when it actually is not.
Sub GetTenantInfo()
Dim wbkCopyFrom As Workbook
Dim wbkCopyTo As Workbook
Dim ws As Worksheet
Dim TenRow As Long
Dim TenantType As String
Dim TenantName As String
Dim PrimaryUnitNo As Long
Dim ShName As String
Dim wkbName As String
Dim FromLusedRow As Long
Dim NewLusedRow As Long
Dim AfterShName As String
Dim ShNumber As Long
Dim iCtr As Long
Dim Start As Long
Dim FromwbkPath
FromwbkPath = Application.GetOpenFilename
Set wbkCopyTo = ThisWorkbook
On Error Resume Next
Set wbkCopyFrom = Workbooks(FromwbkPath)
If wbkCopyFrom Is Nothing Then
Set wbkCopyFrom = Workbooks.Open(FromwbkPath)
On Error GoTo 0
If wbkCopyFrom Is Nothing Then
MsgBox "Cannot find originating file"
Else
Set ws = wbkCopyFrom.Sheets((Replace(MainPagepg.Name, "'", "''")))
'get the last tenant's row in the From workbook
FromLusedRow = ws.Cells(Rows.Count, "F").End(xlUp).Row
'get the last tenant's row in the New workbook
NewLusedRow = MainPagepg.Cells(Rows.Count, "F").End(xlUp).Row
If NewLusedRow < 14 Then
TenRow = 14
Else
TenRow = NewLusedRow + 1
End If
Start = TenRow
For iCtr = Start To FromLusedRow
With ws
'get values from old workbook
ShName = .Cells(iCtr, 56).Value
TenantType = .Cells(iCtr, 3).Value
TenantName = .Cells(iCtr, 6).Value
PrimaryUnitNo = .Cells(iCtr, 4).Value
End With
Application.StatusBar = "Processing. Please Wait."
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
wbkCopyTo.Activate
Call AddSheets.UnProtectSht(Replace(MainPagepg.Name, "'", "''"))
'insert new tenant's row
MainPagepg.Rows(iCtr).Insert (xlDown)
Call AddSheets.ProtectSht(Replace(MainPagepg.Name, "'", "''"))
Call NuSaveTenantName(iCtr, TenantName)
Call NuSaveTenantType(iCtr, TenantType)
Call NuSavePrimaryUnitNo(iCtr, PrimaryUnitNo)
'check if this is the first tenant sheet
If MainPagepg.Range("BD" & iCtr - 1) = "" Then
ShNumber = Firstpg.Index
Else 'get the name of the sheet before new tenant
AfterShName = MainPagepg.Range("BD" & iCtr - 1).Value
ShNumber = Sheets(AfterShName).Index
End If
'copy the sheet
Call AddSheets.UnProtectWkbook
CAMMaster.Copy After:=Sheets(ShNumber)
'name the sheet
ActiveSheet.Name = (ShName)
Call ProtectSht(ShName)
Call AddSheets.ProtectWkbook
'add links from new sheet to Master page
Call AddSheets.AddNameMain(ShName, iCtr)
'add links & formulas to new sheet from main page
Debug.Print "AddSheet call AddFormulaLinks " & _
Application.ScreenUpdating
Call AddSheets.AddFormulaLinks(ShName, iCtr)
Call CopyTenantSheetFields(ShName, wbkCopyFrom)
Next
End If
End If
wbkCopyFrom.Close
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub