Renew button - Application.ScreenUpdating (Transferring Information) 1

[TBL3]

Hi,

I have a button named 'Renew' that contains a macro which transfers the information that has been already filled on the current worksheet into a new opened worksheet by providing the file name into the inputbox that's populated.

Every functionality does work fine, however, I was running through some tests and realized that when a wrong file name is inputted into the inputbox populated, the macro still runs eventhough such file doesn't exists.

Hence, my question is that, how would I code it so that, when the name of the file you input does not match any of the files opened, it will recognize that there isn't such a file and will stop the macro and ideally populate an error msg saying that 'the file you have indicated is not opened.'

Here is the code I have for this macro. Any suggestions will be apprecitated.

Private Sub Renewal2()
On Error Resume Next
Application.ScreenUpdating = False
Dim copyfrom
Dim copyto
copyfrom = ThisWorkbook.Name
copyto = InputBox("Please enter the name of the file you want to copy data to; this file must be already opened.  This is case-sensitive and cannot be the same name as the current workbook.  Do not add the .xls extension.    (Ex. Name of file = 'FileName_MonthDayYear.xls', then input 'FileName_MonthDayYear' in the box).") & ".xls"

If copyto <> ".xls" Then
ActiveSheet.Unprotect ("Ecogarage10")
Windows(copyto).Activate
Sheets("EcoRater Garage").Activate
Windows(copyfrom).Activate
    Range("$F$4").Select
    Selection.Copy
    Windows(copyto).Activate
    Range("$F$4").Select
    ActiveSheet.Paste
    Windows(copyfrom).Activate
    Range("$F$5").Select
    Selection.Copy
    Windows(copyto).Activate
    Range("$F$5").Select
    ActiveSheet.Paste
    Windows(copyfrom).Activate
    Range("$F$6:$G$6").Select
    Selection.Copy
    Windows(copyto).Activate
    Range("$F$6:$G$6").Select
    ActiveSheet.Paste
    Windows(copyfrom).Activate
    Range("$L$4:$M6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(copyto).Activate
    Range("$L$4:$M$6").Select
    ActiveSheet.Paste
    Windows(copyfrom).Activate
.
.
.
.
.
Range("F6:G6").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = True
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.merge
    Range("F4:G4").Select
    Sheet1.Protect ("Ecogarage10")
Application.ScreenUpdating = True

End If
End Sub

 

[TBL3]

One more thing to note is that, once the wrong file name in inputted and macro has been run, all the merged cells becomes unmerged.

If the wrong file name is inputted (does not match any of the file name that is opened), ideally, an error msg should pop-up while the macro is stopped before running.


Cheers,
tbl3

 

[SkipVought]

use the Application.GetOpenFileName method, rather than an input box.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[TBL3]

I am not exactly sure the full functionalities of 'GetOpenFilename'

The following is how I tried to do it, but once the button is clicked, an open file box populates, however, when the file is selected, the merged cells becomes unmerged, and the information doesn't get transferred to the selected file. Also, if you just exist from the open file box, the msgbox appears, but the worksheet still becomes unmerged as well.

Private Sub Renewal2()
On Error Resume Next
Application.ScreenUpdating = False
Dim copyfrom
Dim copyto
copyfrom = ThisWorkbook.Name
copyto = Application.GetOpenFilename("Excel Files (*.xls),*.xls")
    If copyto = False Then
    MsgBox "Please input the correct file name"
    End If

If copyto <> ".xls" Then
ActiveSheet.Unprotect ("password")
Windows(copyto).Activate
Sheets("TEMPLATE").Activate
Windows(copyfrom).Activate
    Range("$F$4").Select
    Selection.Copy
    Windows(copyto).Activate
    Range("$F$4").Select
    ActiveSheet.Paste
.
.
.
    Selection.merge
    Range("F4:G4").Select
    Sheet1.Protect ("password")
Application.ScreenUpdating = True

End If
End Sub

Skip, is it possible when the file gets selected in the open file box, the selected file gets opened with the information transferred?

 

[SkipVought]

Private Sub Renewal2()
    On Error Resume Next
    Application.ScreenUpdating = False
    Dim copyfrom
    Dim copyto
    Dim wsTHIS As Worksheet
    
    Set wsTHIS = ActiveSheet
    
    copyfrom = ThisWorkbook.Name
    copyto = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*")
    
    If copyto = False Then
        MsgBox "Please input the correct file name"
    Else    '[b]
    'open the copyto workbook
    
        With Workbooks.Open(copyto) '[/b]
        
            wsTHIS.Unprotect ("password")
            
            Workbooks(copyfrom).Sheets("[b]??????[/b]").Range("$F$4").Copy
            
            .Sheets("TEMPLATE").Range("$F$4").PasteSpecial xlPasteAll
'            .
'            .
'            .

''WHY MERGE?
'                Selection.Merge

                wsTHIS.Protect ("password")
                
        End With
        Application.ScreenUpdating = True
        
    End If
    
End Sub

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[TBL3]

It is not that I would like the merge the cells, but to prevent the merged cells to be unmerged.

Thanks,
tbl3

 

[SkipVought]

So you're saying that the PASTE, unmerges cells?

What if you did this...

            with .Sheets("TEMPLATE").Range("$F$4")
                 .PasteSpecial xlPasteValues
                 .PasteSpecial xlPasteFormats
            end with

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[TBL3]

I'm not sure if I understood fully.
Will it look like this?

Private Sub Renewal2()
    On Error Resume Next
    Application.ScreenUpdating = False
    Dim copyfrom
    Dim copyto
    Dim wsTHIS As Worksheet
    
    Set wsTHIS = ActiveSheet
    
    copyfrom = ThisWorkbook.Name
    copyto = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*")
    
    If copyto = False Then
        MsgBox "Please select correct file name."
    Else    '
    'open the copyto workbook
    
        With .Sheets("EcoRater Garage").Range("$F$4")
             .PasteSpecial xlPasteValues
             .PasteSpecial xlPasteFormats
        End With
        
        Application.ScreenUpdating = True
    
    End If

End Sub

With the code you have just provided, where does it indicate the name of the file you want to transfer the data into ?


tbl3

 

[SkipVought]

    If copyto = False Then
        MsgBox "Please input the correct file name"
    Else    '
    'open the copyto workbook
    
        With Workbooks.Open(copyto) '
        
            wsTHIS.Unprotect ("password")
            
            Workbooks(copyfrom).Sheets("??????").Range("$F$4").Copy
            [b]
        With .Sheets("EcoRater Garage").Range("$F$4")
             .PasteSpecial xlPasteValues
             .PasteSpecial xlPasteFormats
        End With[/b]
'            .
'            .
'            .

''WHY MERGE?
'                Selection.Merge

                wsTHIS.Protect ("password")
                
        End With
        Application.ScreenUpdating = True
        
    End If

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[TBL3]

I just want to make couple clarifications.

1. The sheet defined in "??????" should be the name of the active worksheet? am I correct?

Workbooks(copyfrom).Sheets("??????").Range("$F$4").Copy

2. I just repeat and replace $F$4 for all the fields that needs to be copied from the active sheet? and Do I have to define which cell it needs to be copied to the new sheet?

With .Sheets("EcoRater Garage").Range"$F$4")
     .PasteSpecial xlPasteValues
     .PasteSpecial xlPasteFormats 
End With

 

[SkipVought]

        With Workbooks.Open(copyto) '
        
            wsTHIS.Unprotect ("password")
            
            Workbooks(copyfrom).Sheets("??????").Range("$F$4").Copy

when you OPEN the copyto workbook, THAT workbook is active, not the copyfrom workbook.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[TBL3]

So basically just use the code you have provided exactly.
Thanks for your help.

Cheers,
tbl3

 

[SkipVought]

Exactly?

Is your copyfrom sheet named ?????????

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[TBL3]

Skip,

I started adding other cells that needs to be copied, and when I ran the macro, the information gets pasted two times.

Ex. Active Sheet cell F5 = hello, New Sheet cell F5 = hellohello

Why is this so??

Private Sub Renewal2()
    On Error Resume Next
    Application.ScreenUpdating = False
    Dim copyfrom
    Dim copyto
    Dim wsTHIS As Worksheet
    
    Set wsTHIS = ActiveSheet
    
    copyfrom = ThisWorkbook.Name
    copyto = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*")
    
    If copyto = False Then
        MsgBox "Please select correct file name."
    Else    '
    'open the copyto workbook
    
        With Workbooks.Open(copyto) '
        
            wsTHIS.Unprotect ("Ecogarage10")
            
            Workbooks(copyfrom).Sheets("EcoRater Garage").Range("$F$4").Copy
                    
        With .Sheets("EcoRater Garage").Range("$F$4")
             .PasteSpecial xlPasteValues
             .PasteSpecial xlPasteFormats
             
        End With
        
            Workbooks(copyfrom).Sheets("EcoRater Garage").Range("$F$5").Copy
                    
        With .Sheets("EcoRater Garage").Range("$F$5")
             .PasteSpecial xlPasteValues
             .PasteSpecial xlPasteFormats
        
        End With
        
            Workbooks(copyfrom).Sheets("EcoRater Garage").Range("$F$6").Copy
                    
        With .Sheets("EcoRater Garage").Range("$F$6")
             .PasteSpecial xlPasteValues
             .PasteSpecial xlPasteFormats
        
        End With
                
                Selection.Merge
                
            wsTHIS.Protect ("Ecogarage10")
                  
        End With
        Application.ScreenUpdating = True
    
    End If

End Sub

 

[SkipVought]

Why not...

        With Workbooks.Open(copyto) '
        
            wsTHIS.Unprotect ("Ecogarage10")
            
            Workbooks(copyfrom).Sheets("EcoRater Garage").Range("$F$4:$F$6").Copy
                    
        With .Sheets("EcoRater Garage").Range("F4")
             .PasteSpecial xlPasteValues
             .PasteSpecial xlPasteFormats
             
        End With
        
                
            wsTHIS.Protect ("Ecogarage10")
                  
        End With

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[TBL3]

What if there are more than those cells.

For example, I16, K20, O100, etc. ??

 

[SkipVought]

holy mackrel!

you can only copy contiguous ranges.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[TBL3]

If there are cells that are non-continguous that needs to be copied, I can't use Application.GetOpenFileName method then??

If so, do I have to use the logic I had previously, or is there a better way?

 

[SkipVought]

Geting the OpenFileName has NOTHING to do with copying???

I do not understand your question.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[TBL3]

You have said previously that I could only copy continguous ranges. And I thought this was due to use of OpenFileName.

If that is not the case, why can I only copy continguous ranges?

And in order to copy non-continguous ranges, is there a specific way to do so?