# Copy a contiguous sub-column of cells

This code searches for the word "Disbursements" and copies all of the rows with data below it, including the row with the specified word. After the rows are copied to a new sheet, the unnecessary rows below the contiguous range of data are deleted. In order to search for the last cell, I used a function that finds the last cell with data.

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?

Sub Reformat_ZZ_CM_BNREG()

Application.ScreenUpdating = False
Application.Calculation = xlManual

'declare variables to search for within bank register
Dim searchText As String
Dim ws As Worksheet
Dim searchCell As Range
Dim newWS As Worksheet
Dim lastCell As String
Dim firstCell As String
Dim lastRow As Long

'set variables to sheet name, search text, and searchCell
searchText = "Disbursements"
Set ws = Sheets("ZZ_CM_BNREG")
lastCell = FindLast(3, "ZZ_CM_BNREG")
'Set lastCell = Range(Cells.Find("*", , xlFormulas, , xlRows, xlPrevious, , , False), Cells.Find("*", , xlFormulas, , xlColumns, xlPrevious, , , False))
newWS.Name = "Bank Register"

'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
End If

End With

'copy range using above function to get last cell in range
'paste range onto the new sheet
'we are starting with the cell containing disbursements
ws.Range(firstCell, lastCell).Copy _
Destination:=newWS.Range("A1")

DeleteRowsAndSheet

End Sub

Sub DeleteRowsAndSheet()

Dim LR As Long
LR = Sheets("Bank Register").Range("A1").End(xlDown).Row

Sheets("Bank Register").Activate
Rows(LR + 1 & ":" & LR + 20).Delete

Sheets("Bank Register").Range("1:1").Delete

Sheets("ZZ_CM_BNREG").Delete

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic

End Sub

• If you create a Class (BankRegister) that has a field for an identifier (ID - use the Register number or other unique qualifier) and a Collection (Disbursements) then as you loop the sheet and find a Disbursement item add that to the collection. Once you've got it all, you then loop the collection and add each to your new sheet. I suggest you avoid Copy/Pasta. If you have an object to work with the world is your oyster so to speak. Jan 15, 2021 at 15:21
• @SᴀᴍOnᴇᴌᴀ Thank you for the clarification. I wasn't sure if it would be appropriate to post it as an answer so that's why I added it to the question. Jan 26, 2021 at 23:58

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


at the beginning of your method and then you turn it back 'on' with:

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic


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

Reformat_ZZ_CM_BNREG
MyMethod

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
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

'Store current Application state
appScrUpdate = Application.ScreenUpdating
appCalc = Application.Calculation

'Turn state off
Application.ScreenUpdating = False
Application.Calculation = xlManual

'Actual code
'...
'...
'...

RestoreState:
Application.ScreenUpdating = appScrUpdate
Application.Calculation = appCalc
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:

1. a worksheet named "ZZ_CM_BNREG" exists
2. a worksheet named "Bank Register" does not exist
3. sheet named "ZZ_CM_BNREG" is a Worksheet (it could be a chart sheet)
4. 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.

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
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
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
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
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_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
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
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
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
End With
End Sub

• @BobtheBuilder No need to buy me a coffee. My reward is knowing that I was able to help. The ExcelAppState is definitely a VBA class. Once you insert a class module, you need to make sure you name it properly in the Properties pane. See Print Screen. Note that the code must end with End Sub but for some reason the webpage is not displaying the code tag properly and you see 3 extra quote-like characters that you should not copy across (see same print screen). You do not need to install any other reference! Jan 27, 2021 at 9:07
• @BobtheBuilder I guess if the workbook has only one sheet it's up to you if you want to rename it but if you end up having more than one then you could display a Userform with a Listbox showing all the sheet names and let the user choose which one to use. The Me keyword always refers to the instance of the class you are currently in. ThisWorkbook is an object like any other class. Code within the ExcelAppState can refer to the current instance with the Me keyword. Similarly, code within a Class1 class can refer to the current instance with Me as well. Jan 27, 2021 at 9:13
• @BobtheBuilder You should not have changed Me to ThisWorkbook. It simply did not work because (I suspect) you did not set-up the class properly (please refer to my previous comment with a print screen). The m_ prefix is just a convention I use to prefix class members. You can use any naming convention you see fit. Jan 27, 2021 at 9:15
• @BobtheBuilder Correct, I load the used range into an array and the search for the first blank row. I've been using the UsedRange property for 8 years and never had issues. As in my response, I always check if it actually set with Is Nothing. Had a quick look at your code and it seems that you declared the ExcelAppState as a standard .bas module. Try to declare it as a class and use the code in my answer to create a new instance using the New keyword. Jan 27, 2021 at 9:19
• @BobtheBuilder Glad it was helpful. Yes, I do use the array function as a standard. I do not want to use Excel Worksheet functions (e.g. COUNTBLANK) because I want to be application independent (e.g. might use it in Access, Word, AutoCAD and so on). I have a standard library to work with arrays here that should work in any VBA-capable application. The function that checks if a row is empty is part of that library. Jan 28, 2021 at 13:10

Updated Code Based on Accepted Solution

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, ActiveWorkbook)
If sourceWS Is Nothing Then
Set sourceWS = GetUpdatedName(ActiveWorkbook)
If sourceWS Is Nothing Then
MsgBox "Please change sheet (tab) name to ZZ_CM_BNREG", vbExclamation, "Cancelled"
Exit Sub
End If
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
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

ExcelAppState.StoreState
ExcelAppState.Sleep
'Dim app As New ExcelAppState: app.Sleep: app.StoreState

'Prepare Target
On Error Resume Next
If Err.Number <> 0 Then
MsgBox "Cannot insert new worksheet", vbExclamation, "Failed"
Err.Clear
ExcelAppState.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
ExcelAppState.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

Public Function GetUpdatedName(ByVal actBook As Workbook) As Worksheet
On Error Resume Next
Set GetUpdatedName = actBook.Worksheets(1)
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