Dear Readers,
In this article I am going to share with you – Two little VBA code which will help you in your day-to-day coding life.
1. How to disable Copying Objects with cells through VBA
When you are trying to move or copy a Sheet or set of Sheets in to another workbook then by default it copies everything. Even the objects lying in that cell, range or Sheet also gets copied in to new Sheet. You may not like to copy all the objects along with the cell contents all the time.
For example:
If you have a Summary page in Excel and you have put a “Download” button in that page which makes a copy of your Summary sheet in a new workbook. In this case in the downloaded Summary sheet you would definitely not like to keep the Download button.. right?? Because there is no point of keeping it there. Then here is the solution – before executing the copy statement you need to disable CopyObjectsWithCells method:
'Disable copying of objects with cells before executing the copy statement
Application.CopyObjectsWithCells = False
'Now Copy the Sheet in to a new Workbook
Sheets("Summary").Copy
'Now again enable the CopyObjectWithCells back
Application.CopyObjectsWithCells = True
2. VBA to Change the Orientation of the Sheet before printing
Sometimes you may need to change the orientation of the page before printing from Excel VBA. It could be used even while exporting your Sheet to PDF format. All you need to do is before executing the Print statement or Export statement you need to Set the Page orientation using below statement:
'To set the orientation as LandScape
Sheet1.PageSetup.Orientation = xlLandscape
'To set the orientation as Portrait
Sheet1.PageSetup.Orientation = xlPortrait
Example: Convert your Sheet in to pdf with LandScape Orientation
Sub Convert_To_PDF_LandScape()
With ActiveSheet
'First Set the orientation of the page
.PageSetup.Orientation = xlLandscape
'Now Export the Sheet to PDF
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\Users\Vish\File_Name.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
End Sub
Example: Convert your Sheet in to pdf with Portrait Orientation
Sub Convert_To_PDF_LandScape()
With ActiveSheet
'First Set the orientation of the page
.PageSetup.Orientation = xlPortrait
'Now Export the Sheet to PDF
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\Users\Vish\File_Name.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
End Sub
Hello seeking for help. I have a sheet which is Range protected, with VBA code, can you pls help me to add more range. here is the code:
Private Sub Worksheet_Change(ByVal Target As Range)
”add employee to database
If Intersect(Target, Range(“C5:I5”)) Is Nothing Then
‘do nothing
Else
If Range(“C5”).Value “” And Range(“D5”).Value “” And Range(“G5”).Value “” And Range(“H5”).Value “” And Range(“I5”).Value “” Then
If Sheets(“Database”).ListObjects(“TblEmployeeList”).Range.Rows.Count >= 10 Then
MsgBox “You can track up to 10 employees in this version of spreadsheet. To add more people go to http://www.YourSpreadsheets.co.uk“, , “Limit reached”
Exit Sub
Else
Dim NewRowA As Integer, LastRowA As Integer, IDNumber As Integer, SortFirst As String, SortSecond As String
Application.ScreenUpdating = False
Call UnlockSheet
NewRowA = 5 + 1 + Sheets(“Database”).ListObjects(“TblEmployeeList”).Range.Rows.Count
IDNumber = 1 + WorksheetFunction.Max(Range(“TblEmployeeList[ID]”))
Cells(NewRowA, 10).Value = ” x”
Cells(NewRowA, 3).Value = Cells(5, 3).Value
Cells(NewRowA, 4).Value = Cells(5, 4).Value
Cells(NewRowA, 5).Value = IDNumber
Cells(NewRowA, 7).Value = Cells(5, 7).Value
Cells(NewRowA, 8).Value = Cells(5, 8).Value
Cells(NewRowA, 9).Value = Cells(5, 9).Value
Range(“C5:I5”).ClearContents
Range(“C5”).Select
If Sheets(“Settings”).Range(“M10”) = Sheets(“Settings”).Range(“AC5”) Then
SortFirst = “C6”
SortSecond = “D6”
Else
SortFirst = “D6”
SortSecond = “C6”
End If
With Sheets(“Database”).ListObjects(“TblEmployeeList”).Sort
.SortFields.Clear
.SortFields.Add Key:=Range(SortFirst), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range(SortSecond), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
”now add a row in the Overview table
”but first disable events as it may cause a cell to be highlighted when a cell with employee name is selected in overview tab
Application.EnableEvents = False
LastRowA = -2 + WorksheetFunction.Max(Sheets(“Overview”).Columns(“A:A”))
With Sheets(“Overview”)
.Unprotect Password:=”SagEeNgineer489″
.Rows(LastRowA).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range(.Cells(17, 2), .Cells(17, 5)).Copy Destination:=.Range(.Cells(18, 2), .Cells(LastRowA + 1, 2))
.Range(.Cells(17, 6), .Cells(17, 9)).Copy Destination:=.Range(.Cells(18, 6), .Cells(LastRowA + 1, 6))
.Protect Password:=”SagEeNgineer489″, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=False
End With
Call LockSheet
Application.EnableEvents = True
Application.CutCopyMode = False
Application.ScreenUpdating = True
End If
End If
End If
I would like to edit whole sheet which is protected. probably add more employees.
here is whole sheet code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
”delete holiday from database
If Intersect(Target, Range(“N6:N100000”)) Is Nothing Then
‘do nothing
Else
If Target.Value “” Then
If MsgBox(“Are you sure you want to delete this holiday from database?”, vbYesNo, “Delete”) = vbYes Then
Application.ScreenUpdating = False
Call UnlockSheet
ActiveSheet.ListObjects(“TblOfficeHolidays”).ListRows(Target.Row – 5).Delete
Cells(Target.Row, Target.Column – 1).Select
”has to repeat unlock otherwise doesn’t want to delete cell
Call UnlockSheet
Target.Delete Shift:=xlUp
Call LockSheet
Application.ScreenUpdating = True
End If
End If
End If
On Error Resume Next
”delete employee from database
If Intersect(Target, Range(“J6:J100000”)) Is Nothing Then
‘do nothing
Else
If Target.Value “” Then
If MsgBox(“This will delete all data linked to this person. Are you sure you want to do it?”, vbYesNo, “Delete”) = vbYes Then
”delete all entries in the holidays table
Dim LastRow As Integer, LastRowC As Integer, Counter As Integer, EmployeeID As Integer
Application.ScreenUpdating = False
Call UnlockSheet
With Sheets(“Database”).ListObjects(“TblEmployeeList”)
EmployeeID = .DataBodyRange.Cells(Target.Row – 5, .ListColumns(“ID”).Index)
‘EmployeeName = .DataBodyRange.Cells(Target.Row – 5, .ListColumns(“Name and Surname”).Index)
End With
With Sheets(“DatabaseHolidays”).ListObjects(“TblDatabase”)
LastRow = .Range.Rows.Count
For Counter = LastRow To 1 Step -1
If .DataBodyRange.Cells(Counter, .ListColumns(“ID”).Index) = EmployeeID Then
.ListRows(Counter).Delete
End If
Next Counter
End With
”delete row in the Overview tab
With Sheets(“Overview”)
.Unprotect Password:=”SagEeNgineer489″
LastRowC = -2 + WorksheetFunction.Max(.Columns(“A:A”))
.Rows(Target.Row + 11).Delete
.Protect Password:=”SagEeNgineer489″, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=False
End With
”delete row in Database tab
ActiveSheet.ListObjects(“TblEmployeeList”).ListRows(Target.Row – 5).Delete
Cells(Target.Row, Target.Column – 1).Select
Target.Delete
Call LockSheet
Application.ScreenUpdating = True
End If
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
”add employee to database
If Intersect(Target, Range(“C5:I5”)) Is Nothing Then
‘do nothing
Else
If Range(“C5”).Value “” And Range(“D5”).Value “” And Range(“G5”).Value “” And Range(“H5”).Value “” And Range(“I5”).Value “” Then
If Sheets(“Database”).ListObjects(“TblEmployeeList”).Range.Rows.Count >= 10 Then
MsgBox “You can track up to 10 employees in this version of spreadsheet. To add more people go to http://www.YourSpreadsheets.co.uk“, , “Limit reached”
Exit Sub
Else
Dim NewRowA As Integer, LastRowA As Integer, IDNumber As Integer, SortFirst As String, SortSecond As String
Application.ScreenUpdating = False
Call UnlockSheet
NewRowA = 5 + 1 + Sheets(“Database”).ListObjects(“TblEmployeeList”).Range.Rows.Count
IDNumber = 1 + WorksheetFunction.Max(Range(“TblEmployeeList[ID]”))
Cells(NewRowA, 10).Value = ” x”
Cells(NewRowA, 3).Value = Cells(5, 3).Value
Cells(NewRowA, 4).Value = Cells(5, 4).Value
Cells(NewRowA, 5).Value = IDNumber
Cells(NewRowA, 7).Value = Cells(5, 7).Value
Cells(NewRowA, 8).Value = Cells(5, 8).Value
Cells(NewRowA, 9).Value = Cells(5, 9).Value
Range(“C5:I5”).ClearContents
Range(“C5”).Select
If Sheets(“Settings”).Range(“M10”) = Sheets(“Settings”).Range(“AC5”) Then
SortFirst = “C6”
SortSecond = “D6”
Else
SortFirst = “D6”
SortSecond = “C6”
End If
With Sheets(“Database”).ListObjects(“TblEmployeeList”).Sort
.SortFields.Clear
.SortFields.Add Key:=Range(SortFirst), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range(SortSecond), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
”now add a row in the Overview table
”but first disable events as it may cause a cell to be highlighted when a cell with employee name is selected in overview tab
Application.EnableEvents = False
LastRowA = -2 + WorksheetFunction.Max(Sheets(“Overview”).Columns(“A:A”))
With Sheets(“Overview”)
.Unprotect Password:=”SagEeNgineer489″
.Rows(LastRowA).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range(.Cells(17, 2), .Cells(17, 5)).Copy Destination:=.Range(.Cells(18, 2), .Cells(LastRowA + 1, 2))
.Range(.Cells(17, 6), .Cells(17, 9)).Copy Destination:=.Range(.Cells(18, 6), .Cells(LastRowA + 1, 6))
.Protect Password:=”SagEeNgineer489″, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=False
End With
Call LockSheet
Application.EnableEvents = True
Application.CutCopyMode = False
Application.ScreenUpdating = True
End If
End If
End If
”add holiday to database
If Intersect(Target, Range(“L5:M5”)) Is Nothing Then
‘do nothing
Else
If Range(“L5”).Value “” And Range(“M5”).Value “” Then
Dim NewRowB As Integer
Application.ScreenUpdating = False
Call UnlockSheet
NewRowB = 5 + 1 + Sheets(“Database”).ListObjects(“TblOfficeHolidays”).Range.Rows.Count
Cells(NewRowB, 14).Value = ” x”
Cells(NewRowB, 13).Value = Cells(5, 13).Value
Cells(NewRowB, 12).Value = Cells(5, 12).Value
Range(“L5:M5”).ClearContents
Range(“L5″).Select
”will sort automatically as this is a table
‘Sheets(“Database”).ListObjects(“TblOfficeHolidays”).Sort.SortFields.Clear
‘Sheets(“Database”).ListObjects(“TblOfficeHolidays”).Sort.SortFields.Add Key:=Range(“L6”), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
‘With Sheets(“Database”).ListObjects(“TblOfficeHolidays”).Sort
‘ .Header = xlGuess
‘ .MatchCase = False
‘ .Orientation = xlTopToBottom
‘ .SortMethod = xlPinYin
‘ .Apply
‘End With
Call LockSheet
Application.ScreenUpdating = True
End If
End If
”sort holiday database if data is changed
If Intersect(Target, Range(“L6:L100000”)) Is Nothing Then
‘do nothing
Else
Application.ScreenUpdating = False
Call UnlockSheet
With Sheets(“Database”).ListObjects(“TblOfficeHolidays”).Sort
.SortFields.Clear
.SortFields.Add Key:=Range(“L6″), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Call LockSheet
Application.ScreenUpdating = True
End If
End Sub
Private Sub UnlockSheet()
ActiveSheet.Unprotect Password:=”SagEeNgineer489″
End Sub
Private Sub LockSheet()
ActiveSheet.Protect Password:=”SagEeNgineer489”, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=False
End Sub