A simple printing pages depending on cell value

[Ken Puls]

Hi Antony,

To copy from one workbook to another, you can use:

Workbooks("Source Workbook Name.xlsx").Worksheets("My Sheet").Range("A1:B15").Copy
Workbooks("Destination Workbook name.xlsx").Worksheets("Target Sheet").Range("G5").PasteSpecial Paste:=xlPasteAll 'or xlPasteValues

That is written in the browser and untested, but it looks right to my sleepy eyes.

FYI, I may not be online until after the weekend, as we're away celebrating a family birthday. Any chances I do get to check in will be sporadic.

[antonywalsh]

Hi Antony,

To copy from one workbook to another, you can use:

Workbooks("Source Workbook Name.xlsx").Worksheets("My Sheet").Range("A1:B15").Copy
Workbooks("Destination Workbook name.xlsx").Worksheets("Target Sheet").Range("G5").PasteSpecial Paste:=xlPasteAll 'or xlPasteValues

That is written in the browser and untested, but it looks right to my sleepy eyes.

FYI, I may not be online until after the weekend, as we're away celebrating a family birthday. Any chances I do get to check in will be sporadic.

Ken

I spoke too soon, I thought last night at 2.00am I had it completed and in the morning I am still getting errors.

Sub deleterows()


Sheets("DATASHEET").Select
    Application.ScreenUpdating = False
    Cells.Select
    Range("B1").Activate
    Selection.EntireColumn.Hidden = False
    Range("A4:Z1077").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$4:$Z$1077").AutoFilter Field:=2, Criteria1:="="
    Rows("20:1077").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=-15
    Range("B65").Select
    ActiveSheet.Range("$A$4:$Z$64").AutoFilter Field:=2
    Selection.AutoFilter
    Columns("A:A").Select
    Selection.EntireColumn.Hidden = True
    Columns("C:C").Select
    Selection.EntireColumn.Hidden = True
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    Columns("N:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("P:P").Select
    Selection.EntireColumn.Hidden = True
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    Columns("T:Y").Select
    Selection.EntireColumn.Hidden = True
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 2
    Range("B5").Select
With Range("b5")
    Range(.Cells(1, 1), .End(xlDown).Cells(1, 25)).Copy
Range("B5").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  ActiveSheet.Paste
End With
With Range("b2")
    Range(.Cells(1, 1), .End(xlDown).Cells(1, 25)).Copy
End With
Sheets("ACCOUNTSPAGE").Select
End Sub

it gets to this part and falls down

Selection.EntireColumn.Hidden = False

It says unable to set the hidden property of the range class. I think this is due to the page being protected. I have tried to enter this information at various places but still cannot get it to work.

With Sheets("DATASHEET")
    .unprotect Password:="password"
    CODE

    .protect Password:="password"
    End With

The worse part is I sent it to my boss as completed because I thought it was.

I would really appreciate any help.

[antonywalsh]

Ken

I have spent alot of time learning over the last couple of days and I am picking things up pretty fast. I have got everything working how I want it now except one thing the protection.

Everything works fine until I put the protection on and then alot of the macros do not work due to hiding columns and copying and pasting etc, the protection stops this from happening.

I need some kind of protection that I can switch on and switch off easily but still allow me to run the macros needed.

I have tried this

Sub ProtectAll()
     Application.ScreenUpdating = False
    Dim wSheet          As Worksheet
    Dim Pwd             As String
     
    Pwd = InputBox("Enter your password to protect all worksheets", "Password Input")
    For Each wSheet In Worksheets
        wSheet.protect Password:=Pwd
    Next wSheet
    Application.OnKey "{ESC}", "BACKTOMAINPAGE"
End Sub
 Sub UnProtectAll()
     Application.ScreenUpdating = False
    Dim wSheet          As Worksheet
    Dim Pwd             As String
     
    Pwd = InputBox("Enter your password to unprotect all worksheets", "Password Input")
    On Error Resume Next
    For Each wSheet In Worksheets
        wSheet.unprotect Password:=Pwd
    Next wSheet
    If Err <> 0 Then
        MsgBox "You have entered an incorect password. All worksheets could not " & _
        "be unprotected.", vbCritical, "Incorect Password"
    End If
    On Error GoTo 0
    Application.OnKey "{ESC}"
End Sub

But when I attempt to run a macro it says the password is not correct. I feel that I have too many of these dotted everywhere which are not working

With Sheets("sheet1")
.unprotect Password:="password"
content
.protect Password:="password"

It would be great if you could let me know a simpler way of protecting the sheets but allowing all the macros to run without having to turn them off and on each time a macro needs to be run.

Thanks for you help

Regards

[Ken Puls]

Hi there,

Sorry for the late reply. I was away all weekend with family.

I'd modify the first routine to put the password there. Why give your users an option to record it?

Sub ProtectAll()
    Application.ScreenUpdating = False
    Dim wSheet          As Worksheet
    Dim Pwd             As String
     
    Pwd = "MyPassword"
    For Each wSheet In Worksheets
        wSheet.Protect Password:=Pwd, userinterfaceonly:=True
    Next wSheet
    Application.OnKey "{ESC}", "BACKTOMAINPAGE"
End Sub

You'll also notice that I added the "userinterfaceonly:=True" keywords to the protection routine. This will protect the worksheets while still letting macros run on them.

The thing that sucks though, is that you need to re-apply that every time the workbook is reopened. To do that, we use a Workbook_Open event (which goes in the ThisWorkbook module):

Private Sub Workbook_Open()
    Call ProtectAll
    
End Sub

(Just make sure you unprotect all the sheets before you run this and set the pwd string to what you want.)

[antonywalsh]

Hi there,

Sorry for the late reply. I was away all weekend with family.

I'd modify the first routine to put the password there. Why give your users an option to record it?

Sub ProtectAll()
    Application.ScreenUpdating = False
    Dim wSheet          As Worksheet
    Dim Pwd             As String
     
    Pwd = "MyPassword"
    For Each wSheet In Worksheets
        wSheet.Protect Password:=Pwd, userinterfaceonly:=True
    Next wSheet
    Application.OnKey "{ESC}", "BACKTOMAINPAGE"
End Sub

You'll also notice that I added the "userinterfaceonly:=True" keywords to the protection routine. This will protect the worksheets while still letting macros run on them.

The thing that sucks though, is that you need to re-apply that every time the workbook is reopened. To do that, we use a Workbook_Open event (which goes in the ThisWorkbook module):

Private Sub Workbook_Open()
    Call ProtectAll
    
End Sub

(Just make sure you unprotect all the sheets before you run this and set the pwd string to what you want.)

Ken

Thanks for that, the last think I am attempting do is to find the end column and end row of data but when there is hidden columns.

I tried what you said but it keeps stopping when it reaches a column with no data in it and the same with the rows and just jumps to the last row in the worksheet 10k+

Any help would be great

Antony

[Simi]

Antony,

You can use the method Ken mentioned to find the last row or column, even if there are hidden columns.
try using this.

Dim lastRow As Long
Dim lastCol As Long

with ActiveSheet
   lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'Change the "A" to whatever column you want to use to find the last row in.  
   lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 'Change the 1 to whatever row you want to find the last column in.
end with

[antonywalsh]

Simi

I tried what Ken said but 'end + right arrow key just took me to the next cell and not the end cell with data.

I have cells filled from a-z

Columns a,c,n,p and t-y will always be empty

I need to copy from A1 to Z? whatever the data goes to and then I need to allow the user to paste this data into another spreadsheet.

Can you help?

regards

[Simi]

I have only started using the .end feature in my code, but hopefully can break it down for you.

If you just it end + right arrow, that takes you to the next cell to the right that has data. This is useful to skip the blank cells when moving to the right but not very helpful to find the last column of data.

Keeping that in mind, if we pick a cell way to the right of the data entered and use end + left arrow, it will take us to the first cell (moving left) that has data in it. This should be the furthest column to the right of your data area.

The .columns.count returns us a value of 16,384 which I believe is the default number of columns on a new worksheet.

lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
So in the above line of code, we start on row 1, column 16,384. Then we move to the left to the first cell that contains data. The column number we just arrived at with data is then stored in the lastCol variable.

You can then use this variable when you are selecting the data you want to copy.

[Ken Puls]

Hi Antony,

Give this a try:

    With ActiveSheet
        .Range("A1:Z" & .Range("Z1").End(xlDown).Row).Copy
        Worksheets("MyTarget").Range("A1").PasteSpecial Paste:=xlPasteValues
    End With