Most times you have Range.Select
followed by Selection.Something
you can remove the Select
and Selection
to leave it Range.Something
. This helps clarify what the code is doing. The same may be true of Worksheet.Select
(or Activate
). But doing this with a worksheet will alter any unqualified Range
variables in your code that follows.
Range
without VariableName.Range
refer to the ActiveSheet
and can lead to issues if you're not aware of this. My first step was to go through and everything after Worksheets(2).Select
to fully qualify it with
Dim secondSheet As Worksheet
Set secondSheet = Worksheets(2)
Range("AK1").Value = "1"
then became secondSheet.Range("AK1").Value = "1"
giving me a lot more confidence that removing the .Select
shouldn't alter the code. I did the same with Worksheets(1).Select
as well. After that I went after the Range.Select
s.
Range("N" & Rows.Count).End(xlUp).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
I took the above Select
and Selection
to be finding where the last cell on a specific column. Range("N" & Rows.Count).End(xlUp).Select
became what follows. My choice of variable names are self describing, helping you immediately understand what the code is there for.
Dim lastCell as range
set lastCell = secondSheet.Range("N" & Rows.Count).End(xlUp)
Going up from this last cell to get a contiguous range Range(Selection, Selection.End(xlUp)).Select
became
Dim modifyRange as Range
Set modifyRange = secondSheet.Range(lastCell, lastCell.End(xlUp))
Lastly replace the Selection
in Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, SkipBlanks:=False, Transpose:=False
with modifyRange
and it's looking a lot better. But this is being done in 3 places on the secondSheet and once on firstSheet. Rather than having duplicated code, create a Sub procedure ConvertToNumeric
that takes in 2 parameters ByVal sheetToUse As Worksheet
and ByVal columnToFindLastCellOn As String
. The names let you know when typing the name ConvertToNumeric<space>
and getting intellisense to show you the names of the arguments you'll supply. Any future changes are made in this single location now be reflected wherever it's called at ensuring the update is correct.
Private Sub ConvertToNumeric(ByVal sheetToUse As Worksheet, ByVal columnToFindLastCellOn As String)
Dim helperCell As Range
Set helperCell = sheetToUse.Range("AK1")
helperCell.value = "1"
helperCell.Copy
Dim lastCell As Range
Set lastCell = sheetToUse.Cells(Rows.Count, columnToFindLastCellOn).End(xlUp)
Dim modifyRange As Range
Set modifyRange = sheetToUse.Range(lastCell, lastCell.End(xlUp))
modifyRange.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, SkipBlanks:=False, Transpose:=False
helperCell.ClearContents
End Sub
You have a few places with comments like 'Format Amount as Accounting
that are describing what you're doing. When this occurs it's pretty safe to make that chunk of code be it's own Sub or Function. Sub if it doesn't return a value or Function if it does.
Using the same idea as above Range("J" & Rows.Count).End(xlUp).Select
became a Dim lastCell As Range
variable and the Range(Selection, Selection.End(xlUp)).Select
became Dim modifyRange As Range
. You get
Private Sub FormatAsAccounting(ByVal sheetToUse As Worksheet, ByVal columnToApplyFormatTo As String)
Dim lastCell As Range
Set lastCell = sheetToUse.Cells(Rows.Count, columnToApplyFormatTo).End(xlUp)
Dim modifyRange As Range
Set modifyRange = sheetToUse.Range(lastCell, lastCell.End(xlUp))
modifyRange.Style = "Comma"
End Sub
It's called in code FormatAsAccounting secondSheet, "J"
where secondSheet
is a worksheet variable and columnToApplyFormatTo
is a string that tells you what column you'll be using. Admittedly the modifyRange
variable isn't actually needed and sheetToUse.Range(lastCell, lastCell.End(xlUp)).Style ...
could be used but serves to illustrate how as code becomes simpler many times it helps clean itself.
The same thing occurred with headers as well.
When you get to the saving a workbook that has copies of your worksheets you have variables Dim ws As Worksheet
that's never used and Dim wbNew As Workbook
that's assigned but then never used. There is also dt
and wbNam
, neither of which are declared. In the VBE coding window go to Tools>Options>Require Variable Declaration. This will put Option Explicit
into any new module and requires you to Dim
every single variable. It takes more thought and effort to code, but doing something well generally takes effort. Future-you will thank current-you for doing so because it'll save you from many needless issues in your code. BTW Debug>Compile VBAProject (Alt+D+L for keyboard shortcut) is your friend. That'll tell the compiler to compile the code and if something isn't correct it'll alert you by taking you straight there. Keep doing that until there's no more compile-time problems.
Back to the code.
You're selecting a sheet, filtering the sheet, selecting all cells on the sheet to copy that information to a sheet that was just added. This is done for the sheet "PP" and "BK". Those copied sheets are then copied to a new workbook only to be deleted in your current workbook. You can avoid this by creating a new workbook and using that variable.
Dim saveBook As Workbook
Set saveBook = Workbooks.Add
Putting that code into a Sub and having your cursor on the word Add
if you press Ctrl+i or Edit>Quick Info you should see Add([Template]) As Workbook
appear. This indicates the Add
function on the Workbooks
collection returns a Workbook
object, which coincidentally is what saveBook
has been dimensioned as. Right clicking on Add
and choosing Definition
(3rd from bottom) will take you to the object browser where you can see at the bottom pane what I just described. This gives you a new workbook to use that you'll eventually save where you want. The Object Browser is another topic, but learning to use it will help tremendously.
You can directly copy a sheet by using the Copy
procedure on a worksheet object and tell it where to be copied to with either the Before
or After
argument.
Dim ppSheet As Worksheet
Set ppSheet = Sheets("pp")
ppSheet.Copy Before:=saveBook.Worksheets(1)
As part of your eventual file name dt
isn't descriptive. I used monthPriorDate
since that's what you're doing with DateAdd
. Putting all the pieces together you get SaveExternalCopy
.
Private Sub SaveExternalCopy()
Dim saveBook As Workbook
Set saveBook = Workbooks.Add
Dim ppSheet As Worksheet
Set ppSheet = Sheets("pp")
ppSheet.UsedRange.AutoFilter field:=31, Criteria1:="Variable1"
ppSheet.Copy Before:=saveBook.Worksheets(1)
Dim ppCopy As Worksheet
Set ppCopy = saveBook.Worksheets(1)
ppCopy.Name = "PP1"
Dim bkSheet As Worksheet
Set bkSheet = Sheets("Bk")
bkSheet.UsedRange.AutoFilter field:=16, Criteria1:="Variable2"
bkSheet.Copy After:=ppCopy
Dim bkCopy As Worksheet
Set bkCopy = Sheets.Add(After:=bkSheet)
bkCopy.Name = "BK1"
Dim monthPriorDate As String
monthPriorDate = Format(DateAdd("m", -1, Now), "yyyy_mm")
'Dont forget to delete any default sheets that are created
'when the workbook is first created.
saveBook.SaveAs "\\user\location\" & "BK_PP_" & monthPriorDate & ".xlsx"
saveBook.Close
End Sub
My final code ended up as follows. Save a copy before running the code as I've not 100% fully tested everything and there might be an unforseen issue that wasn't caught.
PP_Formatting_Saving
now is shorter and everything it's doing is self-descriptive. Each Sub that's called is doing one thing, which makes it easier to fix a problem when looking at 10-20 lines of code instead of a single block of around 90 lines of code. Comments are mostly gone. Comments should describe the why of something being done not the what since what is happening should be apparent. Why is for when one choice was made over another, something like 'Doing it this way over <OtherWaysName> is 5 times faster.
Public Sub PP_Formatting_Saving()
Application.ScreenUpdating = False
Dim secondSheet As Worksheet
Set secondSheet = Worksheets(2)
secondSheet.Select 'This may possible be removable
ConvertToNumeric secondSheet, "N"
ConvertToNumeric secondSheet, "AA"
ConvertToNumeric secondSheet, "G"
FormatAsAccounting secondSheet, "J"
FormatTheHeaderOf secondSheet
secondSheet.Cells.EntireColumn.AutoFit
secondSheet.Columns("O:O").ColumnWidth = 40
secondSheet.Cells.AutoFilter '¿Does this turn it on or off? 'Filter all headers
Dim firstSheet As Worksheet
Set firstSheet = Worksheets(1)
firstSheet.Activate 'This may possible be removable also
firstSheet.Cells.WrapText = False
FormatAsAccounting firstSheet, "C"
ConvertToNumeric firstSheet, "B"
firstSheet.Cells.EntireColumn.AutoFit
FormatTheHeaderOf firstSheet
firstSheet.Cells.AutoFilter
SaveExternalCopy
End Sub
Private Sub ConvertToNumeric(ByVal sheetToUse As Worksheet, ByVal columnToFindLastCellOn As String)
Dim helperCell As Range
Set helperCell = sheetToUse.Range("AK1")
helperCell.value = "1"
helperCell.Copy
Dim lastCell As Range
Set lastCell = sheetToUse.Cells(Rows.Count, columnToFindLastCellOn).End(xlUp)
Dim modifyRange As Range
Set modifyRange = sheetToUse.Range(lastCell, lastCell.End(xlUp))
modifyRange.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, SkipBlanks:=False, Transpose:=False
helperCell.ClearContents
End Sub
Private Sub FormatTheHeaderOf(ByVal sheetToUse As Worksheet)
Dim header As Range
Set header = sheetToUse.Range(sheetToUse.Range("A1"), sheetToUse.Range("A1").End(xlToRight))
With header.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(192, 192, 192) 'RGB(192,192,192) = 12632256
.TintAndShade = 0
.PatternTintAndShade = 0
End With
header.Font.Bold = True
End Sub
Private Sub FormatAsAccounting(ByVal sheetToUse As Worksheet, ByVal columnToApplyFormatTo As String)
Dim lastCell As Range
Set lastCell = sheetToUse.Cells(Rows.Count, columnToApplyFormatTo).End(xlUp)
Dim modifyRange As Range
Set modifyRange = sheetToUse.Range(lastCell, lastCell.End(xlUp))
'NumberFormat could possibly be used instead of Style
'I'm not sure if you have altered the "Comma" Style though
'modifyRange.NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
modifyRange.Style = "Comma"
End Sub
Private Sub SaveExternalCopy()
Dim saveBook As Workbook
Set saveBook = Workbooks.Add
Dim ppSheet As Worksheet
Set ppSheet = Sheets("pp")
ppSheet.UsedRange.AutoFilter field:=31, Criteria1:="Variable1"
ppSheet.Copy Before:=saveBook.Worksheets(1)
Dim ppCopy As Worksheet
Set ppCopy = saveBook.Worksheets(1)
ppCopy.Name = "PP1"
Dim bkSheet As Worksheet
Set bkSheet = Sheets("Bk")
bkSheet.UsedRange.AutoFilter field:=16, Criteria1:="Variable2"
bkSheet.Copy After:=ppCopy
Dim bkCopy As Worksheet
Set bkCopy = Sheets.Add(After:=bkSheet)
bkCopy.Name = "BK1"
Dim monthPriorDate As String
monthPriorDate = Format(DateAdd("m", -1, Now), "yyyy_mm")
'Dont forget to delete any default sheets that are created
'when the workbook is first created.
saveBook.SaveAs "\\user\location\" & "BK_PP_" & monthPriorDate & ".xlsx"
saveBook.Close
End Sub
Lastly Rubberducks Code Inspections brought up a lot of what I addressed and has been very helpful to my VBA knowledge and improving my coding habits. I'm a contributor and openly biased in favor of it.