I will address your code in sections and at the end I will provide a full updated code based on the touched subjects.
Application state
You are turning the Application 'off' with:
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.DisplayAlerts = False
at the beginning of your method and then you turn it back 'on' with:
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.DisplayAlerts = True
at the end of another method.
It's a good idea to turn things back on within the scope of the same method. In your case you would add the latter 3 lines at the end of the Reformat_ZZ_CM_BNREG method immediately after calling the DeleteRowsAndSheet method. You should not rely on another method to 'clean-up' for you. What if you decide that you don't need to call that method in the future? There is a high chance you will forget to move the 'clean-up' code back in the main method.
How about turning things 'off' and then back 'on'. It's not a good idea to do this, even if it works for you in this situation, because in time you can get used to this kind of approach and repeat it without giving too much thought. Imagine you have another method called Main that turns the application 'off' and then calls your Reformat_ZZ_CM_BNREG method and then does other stuff like calling a method called MyMethod and then finally turns the application back 'on'. Something like:
Sub Main()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.DisplayAlerts = False
Reformat_ZZ_CM_BNREG
MyMethod
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.DisplayAlerts = True
End Sub
What if MyMethod expects the calculation to be 'off'? Well, Reformat_ZZ_CM_BNREG actually turns things back 'on' and you can clearly see this is not what MyMethod (or even Main expects).
What if the Calculation needs to be Manual all the time because this is what the user of the Workbook wants?
The best approach, which you should always use, is to make no assumption of what the current state is because you have no control of what other higher-level methods might expect/do with the state. Your method should look like this:
Sub Reformat_ZZ_CM_BNREG()
Dim appScrUpdate As Boolean
Dim appCalc As XlCalculation
Dim appDispAlert As Boolean
'Store current Application state
appScrUpdate = Application.ScreenUpdating
appCalc = Application.Calculation
appDispAlert = Application.DisplayAlerts
'Turn state off
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.DisplayAlerts = False
'Actual code
'...
'...
'...
RestoreState:
Application.ScreenUpdating = appScrUpdate
Application.Calculation = appCalc
Application.DisplayAlerts = appDispAlert
End Sub
RestoreState: line label can be used in case you want to early exit the method using something like GoTo RestoreState which would still do the 'clean-up'
In short, you restore the state as it was, making no assumptions, to make sure you do not impact logic somewhere else.
There is a lot of boilerplate code to do this so I use a class instead so that I can have multiple instances with stored state at any given time. Here is what I usually use, and the code above would get simplified to something like:
Sub Reformat_ZZ_CM_BNREG()
Dim app As New ExcelAppState
app.StoreState
app.Sleep
'Actual code
'...
'...
'...
app.RestoreState
End Sub
Indentation
For me, it is much easier to read this:
Function DoSomething() As Integer
Dim iNumber As Integer
For iNumber = 1 To 5
DoSomething = DoSomething + iNumber
Next iNumber
End Sub
compared to this:
Function DoSomething() As Integer
Dim iNumber As Integer
For iNumber = 1 To 5
DoSomething = DoSomething + iNumber
Next iNumber
End Sub
especially when I have a large number of methods. Although your code is working, please consider this aesthetic aspect when writing code. All code that is within the scope of the method should have an extra indentation level than the method definition.
Hardcoding
You are using the same string literals in multiple places: "Disbursements", "ZZ_CM_BNREG", "Bank Register". Consider declaring them as constants so that you only need to change them (if needed) in a single place:
Const searchText As String = "Disbursements"
Const sourceShtName As String = "ZZ_CM_BNREG"
Const targetShtName As String = "Bank Register"
If you ever decide to receive these as method parameters then all you need to do is to move the constants (without the Const keyword) into the method definition without needing other changes e.g. Sub Reformat_ZZ_CM_BNREG(ByVal searchText As String, ByVal sourceShtName As String, ByVal targetShtName). Might not be useful here, but you get the idea.
Worksheet assumptions
You are making the following assumptions:
- a worksheet named "ZZ_CM_BNREG" exists
- a worksheet named "Bank Register" does not exist
- sheet named "ZZ_CM_BNREG" is a Worksheet (it could be a chart sheet)
- the workbook is unprotected
Obviously, it works for you but it's better to be a bit precautious to avoid unexpected errors and behaviour. Consider this: if any of the assumptions would fail then a runtime error would be raised, and you would not get the chance to restore the application state (or do other clean-up operations that might be required).
Consider an auxiliary function to retrieve the worksheet:
Public Function GetWorksheetByName(ByVal wsName As String, ByVal book As Workbook) As Worksheet
On Error Resume Next
Set GetWorksheetByName = book.Worksheets(wsName)
On Error GoTo 0
End Function
you could simply use it like this:
Set ws = GetWorksheetByName(sourceShtName, ThisWorkbook)
If ws Is Nothing Then
'Do something e.g. show a message box if needed, restore state or exit method
'...
End If
Notice the auxiliary function uses the Worksheets collection instead of the Sheets collection.
How about these 2 lines?
Set newWS = Sheets.Add(After:=Sheets("ZZ_CM_BNREG"))
newWS.Name = "Bank Register"
As mentioned, these would fail if the workbook is protected or if another sheet with the same name already exists. You can guard with something like:
On Error Resume Next
Set newWs = ThisWorkbook.Worksheets.Add(After:=ws)
If Err.Number <> 0 Then
MsgBox "Cannot insert new worksheet", vbExclamation, "Failed"
Err.Clear
'Restore state or exit method
End If
newWs.Name = targetShtName
If Err.Number <> 0 Then
MsgBox "Cannot rename worksheet", vbExclamation, "Failed"
'This might not be critical so just resume
End If
On Error GoTo 0
Notice that I haven't retrieved the source worksheet again, unnecessarily. Instead I simply used After:=ws
Finding desired range
In order to search for the last cell, I used a function that finds the last cell with data.
I am not sure what the 3 value does when calling the FindLast method with FindLast(3, "ZZ_CM_BNREG"). I suspect you are starting from the 3rd row.
The commented line Set lastCell = Range(Cells.Find("*", , xlFormulas, , xlRows, xlPrevious, , , False), Cells.Find("*", , xlFormulas, , xlColumns, xlPrevious, , , False)) returns a Range object while the variable was declared as text with Dim lastCell As String. The commented line simply does not compile if I uncomment it. It's missing a trailing .Address and the Set needs to be removed. Anyway, I assume your FindLast function returns the text address of the last row and column with data in a similar manner with the modified commented line.
You are looking for the desired text with:
'Unmerge all cells in Column A & get cell address of searchCell
With ws
ws.Activate
Range("A:A").UnMerge
Set searchCell = .Cells.Find(What:="Disbursements", _
SearchFormat:=True)
If searchCell Is Nothing Then
MsgBox ("Error")
Else
firstCell = searchCell.Address
End If
End With
but although you are unmerging column A you are searching for your text within the whole worksheet with ws.Cells.Find(What:="Disbursements", SearchFormat:=True) (ws is implied from the With block).
Assuming there is no "Disbursements" value in columns A and B but there is such a value in column C then your code copies data starting with column C and lose the information in column A and B. As I am unsure if this is intended functionality or not, I made the assumption that you want all columns of data regardless where the keyword is found.
Instead of deleting the rows below the contiguous range, should I just copy the contiguous rows to begin with? Is there a better way to delete the rows below the first blank row?
Yes, it's faster to simply copy only what you need instead of copying useless data that you are going to delete anyway. Your second question suggests that you are only interested in data up to (but not including) the first blank row.
I do not know what you consider a "blank row" to be. I can see that you find the last row (in the target sheet) with Sheets("Bank Register").Range("A1").End(xlDown).Row but that means you are actually looking for the first blank cell in the 'A' column and you don't care if there is data in the rest of the columns. Anyway, I assumed that you are interested in actual "blank rows" (i.e. no data in any of the columns) not just on the 'A' column. Here is a function that can check if a row is empty for a 2D array:
Private Function Is2DArrayRowEmpty(arr() As Variant, ByVal rowIndex As Long, Optional ByVal ignoreEmptyStrings As Boolean = False) As Boolean
Dim j As Long
Dim v As Variant
For j = LBound(arr, 2) To UBound(arr, 2)
v = arr(rowIndex, j)
Select Case VBA.VarType(v)
Case VbVarType.vbEmpty
'Continue to next element
Case VbVarType.vbString
If Not ignoreEmptyStrings Then Exit Function
If v <> vbNullString Then Exit Function
Case Else
Exit Function
End Select
Next j
Is2DArrayRowEmpty = True 'If code reached this line then row is Empty
End Function
Reading the worksheet's used range into an array should give us the flexibility to find the desired range faster.
It's not really needed to insert a new worksheet (and to turn the application state to 'off' and later back 'on') if we cannot find any data that we want to take across. It makes more sense to first search for the data and only then proceed with the other operations.
Final code
Code in a standard module:
Option Explicit
Sub Reformat_ZZ_CM_BNREG()
Const searchText As String = "Disbursements"
Const sourceShtName As String = "ZZ_CM_BNREG"
Const targetShtName As String = "Bank Register"
Dim sourceWS As Worksheet
Dim targetWS As Worksheet
Set sourceWS = GetWorksheetByName(sourceShtName, ThisWorkbook)
If sourceWS Is Nothing Then
MsgBox "Missing worksheet", vbExclamation, "Cancelled"
Exit Sub
End If
Dim rngUsed As Range
On Error Resume Next
Set rngUsed = sourceWS.UsedRange
On Error GoTo 0
If rngUsed Is Nothing Then
MsgBox "Sheet has no data", vbExclamation, "Cancelled"
Exit Sub
ElseIf rngUsed.Count = 1 Then
MsgBox "Sheet has only 1 cell of data", vbExclamation, "Cancelled"
Exit Sub
End If
Dim arrData() As Variant: arrData = rngUsed.Value2
Dim lowRowIndex As Long: lowRowIndex = LBound(arrData, 1)
Dim uppRowIndex As Long: uppRowIndex = UBound(arrData, 1)
Dim v As Variant
Dim i As Long
Dim firstRow As Long
Dim lastRow As Long
i = lowRowIndex
For Each v In arrData 'Traverses array in column-wise order (faster than For...To)
If VarType(v) = vbString Then
If InStr(1, v, searchText, vbTextCompare) > 0 Then
firstRow = i + 1
Exit For
End If
End If
i = i + 1
If i > uppRowIndex Then 'Next column follows - You might want to Exit For if you are only interested in the first column
i = lowRowIndex
End If
Next v
If firstRow = 0 Then
MsgBox "Text not found", vbExclamation, "Cancelled"
Exit Sub
End If
'Find last non-blank row
lastRow = uppRowIndex
For i = firstRow To uppRowIndex
If Is2DArrayRowEmpty(arrData, i, True) Then
lastRow = i - 1
Exit For
End If
Next i
If lastRow < firstRow Then
MsgBox "No rows found after desired row", vbExclamation, "Cancelled"
Exit Sub
End If
Dim app As New ExcelAppState: app.Sleep: app.StoreState
'Prepare Target
On Error Resume Next
Set targetWS = ThisWorkbook.Worksheets.Add(After:=sourceWS)
If Err.Number <> 0 Then
MsgBox "Cannot insert new worksheet", vbExclamation, "Failed"
Err.Clear
app.RestoreState
Exit Sub
End If
targetWS.Name = targetShtName
If Err.Number <> 0 Then
MsgBox "Cannot rename worksheet", vbInformation, "Renaming skipped"
'This might not be critical so just continue
End If
On Error GoTo 0
'Write data
With rngUsed
Range(.Cells(firstRow, 1), .Cells(lastRow, .Columns.Count)).Copy _
Destination:=targetWS.Cells(1, 1)
End With
sourceWS.Delete
app.RestoreState
End Sub
Public Function GetWorksheetByName(ByVal wsName As String, ByVal book As Workbook) As Worksheet
On Error Resume Next
Set GetWorksheetByName = book.Worksheets(wsName)
On Error GoTo 0
End Function
Private Function Is2DArrayRowEmpty(arr() As Variant, ByVal rowIndex As Long, Optional ByVal ignoreEmptyStrings As Boolean = False) As Boolean
Dim j As Long
Dim v As Variant
For j = LBound(arr, 2) To UBound(arr, 2)
v = arr(rowIndex, j)
Select Case VBA.VarType(v)
Case VbVarType.vbEmpty
'Continue to next element
Case VbVarType.vbString
If Not ignoreEmptyStrings Then Exit Function
If v <> vbNullString Then Exit Function
Case Else
Exit Function
End Select
Next j
Is2DArrayRowEmpty = True 'If code reached this line then row is Empty
End Function
and of course, a simplified version of the ExcelAppState class (that I linked to above). This one uses only the 3 application properties that you were using:
Option Explicit
Private m_calculationMode As XlCalculation
Private m_screenUpdating As Boolean
Private m_displayAlerts As Boolean
Private m_hasStoredState As Boolean
Private m_hasStoredCalcMode As Boolean
Public Sub StoreState()
With Application
On Error Resume Next 'In case no Workbook is opened
m_calculationMode = .Calculation
m_hasStoredCalcMode = (Err.Number = 0)
On Error GoTo 0
m_screenUpdating = .ScreenUpdating
m_displayAlerts = .DisplayAlerts
End With
m_hasStoredState = True
End Sub
Public Sub RestoreState(Optional ByVal maxSecondsToWait As Integer)
If Not m_hasStoredState Then
Err.Raise 5, TypeName(Me) & ".RestoreState", "State not stored"
End If
With Application
If m_hasStoredCalcMode Then
On Error Resume Next
If .Calculation <> m_calculationMode Then .Calculation = m_calculationMode
On Error GoTo 0
End If
If .ScreenUpdating <> m_screenUpdating Then .ScreenUpdating = m_screenUpdating
If .DisplayAlerts <> m_displayAlerts Then .DisplayAlerts = m_displayAlerts
End With
m_hasStoredState = False
End Sub
Public Sub Sleep()
With Application
On Error Resume Next
If .Calculation <> xlCalculationManual Then .Calculation = xlCalculationManual
On Error GoTo 0
If .ScreenUpdating Then .ScreenUpdating = False
If .DisplayAlerts Then .DisplayAlerts = False
End With
End Sub
Public Sub Wake(Optional ByVal maxSecondsToWait As Integer = 10)
With Application
On Error Resume Next
If .Calculation <> xlCalculationAutomatic Then .Calculation = xlCalculationAutomatic
On Error GoTo 0
If Not .ScreenUpdating Then .ScreenUpdating = True
If Not .DisplayAlerts Then .DisplayAlerts = True
End With
End Sub
