Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Renew button - Application.ScreenUpdating (Transferring Information) 1

Status
Not open for further replies.

TBL3

Programmer
Jun 6, 2011
50
CA
Hi,

I was trying to code a macro that transfers specified cell information from one workbook to another by creating a Renew button. The desired functionality of this button is to simply copy & paste the information from the current TEMPLATE to a new TEMPLATE (the two templates are identicle).

The code below is the what I have started with, but I am not sure if this is the right approach.

One problem with this code that I cannot find the answer to is that the merged cells becomes unmerged (for example the cell f4 in the code below are merged with f4:h4 in the current TEMPLATE, however, once the Renew button macro processed, all the merged cells become unmerged and all the spacing in the template gets distorted).

Also, in order for the transformation to occur, the current TEMPLATE and the new TEMPLATE has to be open at the same time. Why is this so and does this has to be done all the time?

Lastly, when clicking the Renew button, the msg box populates as it is indicated in the code below. However, either way if I click 'OK' or 'Cancel' it then populates another msg box that says 'Do you want to replace the contents of the destination cells?' I am not sure where this is being triggered, how there is no difference between 'OK' or 'Cancel'

I hope I was clear enough for good understanding of my situation.
Any suggestions of attacking this problem will be appreciated it.

Thanks,

Code:
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.") & ".xls"
ActiveSheet.Unprotect ("TEMPLATE")
Windows(copyto).Activate
Sheets("TEMPLATE").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:$M46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(copyto).Activate
    Range("$L$4:$M$6").Select
    ActiveSheet.Paste
    Windows(copyfrom).Activate
    Range("E11:L11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(copyto).Activate
    Range("E11:L11").Select
    ActiveSheet.Paste
    Windows(copyfrom).Activate
    ActiveSheet.Protect ("TEMPLATE")
    Range("F4").Select
    Windows(copyfrom).Activate
    Range("F4").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("F5").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("F6:G6").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = True
        .IndentLevel = 0
        .ShrinkToFit = Truse
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.merge
    Range("F4:G4").Select
    Sheet1.Protect ("TEMPLATE")
Application.ScreenUpdating = True
End Sub
 


hi,

what about this range difference-- M46 and M6???
Code:
        Windows(copyfrom).Activate
        Range("$L$4:$M46").Select
        Application.CutCopyMode = False
        Selection.Copy
        Windows(copyto).Activate
        Range("$L$4:$M$6").Select
        ActiveSheet.Paste


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 



quote]merged cells becomes unmerged [/quote]
Merge cells will continue to be a problem. Your must code very carefully in order to accommodate. I would Merger Across Selection instead.

Is there any reason that you could not 1) select ALL the cells in the sheet, 2) COPY, 3) select A1 in the target sheet and 4) Paste Special -- ALL?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Hi Skip,

Thanks for the input.
Questions and Clarifications are provided below:

1. the Range difference was just a minor mistake I made when copy&pasting to post it on tek-tips. It says $L$4:$M$4 in the actual code.

2. What do you mean by 'must code very carefully in order to accommodate?' and also, 'I would Merger Across Selection instead?' Could you elaborate on these?

3. The reason why I couldn't select all the cells in the sheet is due to the format of the TEMPLATE. The TEMPLATE is formatted such as an application form so that there are required fields that must be inputted for the form to be finished. Thus, information of specific cells needs to be copied and pasted to a new TEMPLATE, and not ALL.


Cheers
TBL3,
 


merge cells are a bane rather than a blessing. Programming, you must identify the MergeArea, not just a single cell.

oddly enough, you are merging a range that has descrete values, thereby destroying all those values but one!

merged cells are difficult to auto fit when wrapping is used.

In Format Cells window, alignment tab, see center across selection



Can you select a single range that excludes the cells you do not want to copy?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
I guess I haven't explained myself thoroughly.

When the msgbox populates, once I input the according file name (.xls) I wish to transfer the information to, everything works as I desired. All the cells are being copied&pasted to the correct cells without becoming unmergerd.

However, the problem occurs once I click 'Cancel' or close the msgbox that has been populated. All the merged cells becomes unmerged (on the current TEMPLATE, the one that needs to copy the information from).

Hence, is there a way so that if you select 'Cancel' or close the msgbox that populates when Renew Button has been selected, nothing happens to the current workbook you are on?

Hope this is more clear.
 



Code:
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.") & ".xls"

If copyto <> ".xls" Then
  'do your stuff here
End If


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
One more thing to mention is that, it is not a msgbox, but inputbox.

I am aware that, for uses of msgbox, I can code it simply using IF/ELSEIF statements.

For example,
Code:
Sub ResetMe()
Dim Ans As Variant

Ans = MsgBox("Do you wish to clear all of the fields?.", vbYesNo)

If Ans = vbYes Then
Else
Else If
End Sub

In similar to the code above, I wish to have a functionality so that when the user decides to cancel the Renew process, they have the ability to do so without having TEMPLATE to be distorted by all the merged cells becoming unmerged.

 


Yes, as per my code just above.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Hi Skip,

Everything seems to function the way I wished it to be.
Thanks for your input.


Cheers,
TBL3
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top