Runtime Error 91

rtr1811

New Member
Joined
Jun 3, 2020
Messages
24
Office Version
  1. 2007
Platform
  1. Windows
I got runtime error 91 on executing the following code. Can anyone help me to resolve this error?



Option Explicit

Sub MergeSheets5()

Dim wsD As Worksheet
Dim ws As Worksheet

Set wsD = ThisWorkbook.Sheets("Wardwise")

'delete previous data
wsD.Range("B6:R10000").Clear

Dim data_lastrow As Long
Dim FoundCell As Range
Dim data_lastrow1 As Long


For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Wardwise" Then
Else
'unmerge all cells
ws.Range("B8:R10000").UnMerge


'count the lastrow of each sheets
data_lastrow = wsD.Cells(Rows.Count, 4).End(xlUp).Row + 1

'Find net total as last row
Const WHAT_TO_FIND As String = "Net Total"
Set FoundCell = ws.Range("B:B").Find(What:=WHAT_TO_FIND)
data_lastrow1 = FoundCell.Row

'copy sheets into Destination sheet
ws.Range("C8:Q" & data_lastrow1).Copy Destination:=wsD.Range("D" & data_lastrow)
ws.Range("B8:B" & data_lastrow1).Copy Destination:=wsD.Range("B" & data_lastrow)

wsD.Range("C" & data_lastrow & ":C" & data_lastrow + data_lastrow1 - 8).Value = ws.Name

End If
Next ws

data_lastrow = wsD.Cells(Rows.Count, 3).End(xlUp).Row + 1

'remove row contains TOTAL
Dim d As Long 'row number
d = 6
Do Until d = data_lastrow 'loop through each row
If wsD.Cells(d, 2).Value Like "*" & "Total" & "*" Then
wsD.Rows(d).EntireRow.Delete
Else
d = d + 1
End If
Loop

'refresh last row of destination sheet
wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("C5"), Order1:=xlAscending, Header:=xlYes
wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlYes
wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("D5"), Order1:=xlAscending, Header:=xlYes

wsD.AutoFilterMode = False

Set wsD = Nothing
Set ws = Nothing

MsgBox "Done merged"

End Sub
 
What happens if you change your Find line to this:
VBA Code:
        Set FoundCell = ws.Range("B:B").Find(What:=WHAT_TO_FIND, MatchCase:=False)
Upon execution of the above code the attached Msg Box gets displayed. Here's my modified code:

VBA Code:
Option Explicit

Sub MergeSheets5()

Dim wsD As Worksheet
Dim ws As Worksheet

Set wsD = ThisWorkbook.Sheets("Wardwise")

'delete previous data
wsD.Range("B6:R10000").Clear

Dim data_lastrow As Long
Dim FoundCell As Range
Dim data_lastrow1 As Long
    
    
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Wardwise" Then
Else
'unmerge all cells
ws.Range("B8:R10000").UnMerge


'count the lastrow of each sheets
data_lastrow = wsD.Cells(Rows.Count, 4).End(xlUp).Row + 1

'Find net total as last row
Const WHAT_TO_FIND As String = "Net Total"
Set FoundCell = ws.Range("B:B").Find(What:=WHAT_TO_FIND, MatchCase:=False)
If FoundCell Is Nothing Then
            MsgBox "The search term: " & WHAT_TO_FIND & "  was not found"
            Exit Sub
        End If
data_lastrow1 = FoundCell.Row

'copy sheets into Destination sheet
ws.Range("C8:Q" & data_lastrow1).Copy Destination:=wsD.Range("D" & data_lastrow)
ws.Range("B8:B" & data_lastrow1).Copy Destination:=wsD.Range("B" & data_lastrow)

wsD.Range("C" & data_lastrow & ":C" & data_lastrow + data_lastrow1 - 8).Value = ws.Name

End If
Next ws

data_lastrow = wsD.Cells(Rows.Count, 3).End(xlUp).Row + 1

'remove row contains TOTAL
Dim d As Long 'row number
d = 6
Do Until d = data_lastrow  'loop through each row
    If wsD.Cells(d, 2).Value Like "*" & "Total" & "*" Then
        wsD.Rows(d).EntireRow.Delete
    Else
        d = d + 1
    End If
Loop

'refresh last row of destination sheet
wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("C5"), Order1:=xlAscending, Header:=xlYes
wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlYes
wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("D5"), Order1:=xlAscending, Header:=xlYes

wsD.AutoFilterMode = False

Set wsD = Nothing
Set ws = Nothing

MsgBox "Done merged"

End Sub



1720424757467.png
 
Last edited:
Upvote 0

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Out of interest what do you get if you change the line to...
VBA Code:
Set FoundCell = ws.Range("B:B").Find(What:=WHAT_TO_FIND, LookAt:=xlPart, MatchCase:=False)
 
Upvote 0
You really should have provided an XL2BB of you data. I looked at your past posts and downloaded your file.
The issue is you have merged cells. Most experienced Excel users tend to avoid these like the plague since they generally come back to bite you.
It is much better to use center across selection and as far as I can tell you could have gotten the same result using that instead of using Merged Cells.

The quickest fix in your case is to expand your column range to from B:B to B:D
Rich (BB code):
Set FoundCell = ws.Range("B:D").Find(What:=WHAT_TO_FIND, MatchCase:=False)
Since Net Total won't appear anywhere else you could even expand to more columns in case you end up merging more cells.
In fact 3 sheets have B:C merged while WardWise had B:D merged so maybe go the whole hog and make it:
Rich (BB code):
    Set FoundCell = ws.UsedRange.Find(What:=WHAT_TO_FIND, MatchCase:=False)

An alternative might be:
Rich (BB code):
    'Replace this
    Const WHAT_TO_FIND As String = "Net Total"
    Set FoundCell = ws.Range("B:C").Find(What:=WHAT_TO_FIND, MatchCase:=False)
    If FoundCell Is Nothing Then
        MsgBox "The search term: " & WHAT_TO_FIND & "  was not found"
        Exit Sub
    End If
    data_lastrow1 = FoundCell.Row

    'With this
    Dim rowNetTotal As Long
    Const WHAT_TO_FIND As String = "Net Total"
    With Application
        rowNetTotal = .IfError(.Match("Net Total", ws.Range("B:B"), 0), 0)
    End With
    
    If rowNetTotal = 0 Then
        MsgBox "The search term: " & WHAT_TO_FIND & "  was not found"
        Exit Sub
    End If
    
    data_lastrow1 = rowNetTotal

Data from your file:
20240701 VBA Find error 91 rtr1811.xlsm
ABCDEFGHIJKLMNOP
3073910090101
308Sub Total17519723173194
309ADD 110192323
310ADD 210192525
311Sub Total4848
312DEL 210092020
313Sub Total2020
3149th Ward Grand Total17720500002301752020
315Net Total15591625000065820149415430
Wardwise
Cell Formulas
RangeFormula
N307:O307,N309:O310,N312:O312N307=E307-(H307+K307)
N308:O308,K308:L308,E308:F308N308=SUM(N284:N307)
N311:O311,E311:F311N311=SUM(N309:N310)
N313:O313,E313:F313N313=SUM(N312)
E314:P314E314=E308+E311-E313
E315:P315E315=E47+E79+E118+E149+E187+E217+E261+E283+E314
 
Last edited:
Upvote 0
Code:
[COLOR=rgb(44, 130, 201)][B]Dim rowNetTotal As Long
[/QUOTE]
[QUOTE="Alex Blakenburg, post: 6197801, member: 473943"]
Const WHAT_TO_FIND As String = "Net Total"
With Application
rowNetTotal = .IfError(.Match("Net Total", ws.Range("B:B"), 0), 0)
End With

If rowNetTotal = 0 Then
MsgBox "The search term: " & WHAT_TO_FIND & " was not found"
Exit Sub
End If
[/B][/COLOR]
[B][COLOR=rgb(44, 130, 201)] data_lastrow1 = rowNetTotal[/COLOR][/B]

You really should have provided an XL2BB of you data. I looked at your past posts and downloaded your file.
The issue is you have merged cells. Most experienced Excel users tend to avoid these like the plague since they generally come back to bite you.
It is much better to use center across selection and as far as I can tell you could have gotten the same result using that instead of using Merged Cells.

The quickest fix in your case is to expand your column range to from B:B to B:D
Rich (BB code):
Set FoundCell = ws.Range("B:D").Find(What:=WHAT_TO_FIND, MatchCase:=False)
Since Net Total won't appear anywhere else you could even expand to more columns in case you end up merging more cells.
In fact 3 sheets have B:C merged while WardWise had B:D merged so maybe go the whole hog and make it:
Rich (BB code):
    Set FoundCell = ws.UsedRange.Find(What:=WHAT_TO_FIND, MatchCase:=False)

An alternative might be:
Rich (BB code):
    'Replace this
    Const WHAT_TO_FIND As String = "Net Total"
    Set FoundCell = ws.Range("B:C").Find(What:=WHAT_TO_FIND, MatchCase:=False)
    If FoundCell Is Nothing Then
        MsgBox "The search term: " & WHAT_TO_FIND & "  was not found"
        Exit Sub
    End If
    data_lastrow1 = FoundCell.Row

    'With this
    Dim rowNetTotal As Long
    Const WHAT_TO_FIND As String = "Net Total"
    With Application
        rowNetTotal = .IfError(.Match("Net Total", ws.Range("B:B"), 0), 0)
    End With
    
    If rowNetTotal = 0 Then
        MsgBox "The search term: " & WHAT_TO_FIND & "  was not found"
        Exit Sub
    End If
    
    data_lastrow1 = rowNetTotal

Data from your file:
20240701 VBA Find error 91 rtr1811.xlsm
ABCDEFGHIJKLMNOP
3073910090101
308Sub Total17519723173194
309ADD 110192323
310ADD 210192525
311Sub Total4848
312DEL 210092020
313Sub Total2020
3149th Ward Grand Total17720500002301752020
315Net Total15591625000065820149415430
Wardwise
Cell Formulas
RangeFormula
N307:O307,N309:O310,N312:O312N307=E307-(H307+K307)
N308:O308,K308:L308,E308:F308N308=SUM(N284:N307)
N311:O311,E311:F311N311=SUM(N309:N310)
N313:O313,E313:F313N313=SUM(N312)
E314:P314E314=E308+E311-E313
E315:P315E315=E47+E79+E118+E149+E187+E217+E261+E283+E314
The Same Message Box is displayed ie Runtime error is not resolved.
You really should have provided an XL2BB of you data. I looked at your past posts and downloaded your file.
The issue is you have merged cells. Most experienced Excel users tend to avoid these like the plague since they generally come back to bite you.
It is much better to use center across selection and as far as I can tell you could have gotten the same result using that instead of using Merged Cells.

The quickest fix in your case is to expand your column range to from B:B to B:D
Rich (BB code):
Set FoundCell = ws.Range("B:D").Find(What:=WHAT_TO_FIND, MatchCase:=False)
Since Net Total won't appear anywhere else you could even expand to more columns in case you end up merging more cells.
In fact 3 sheets have B:C merged while WardWise had B:D merged so maybe go the whole hog and make it:
Rich (BB code):
    Set FoundCell = ws.UsedRange.Find(What:=WHAT_TO_FIND, MatchCase:=False)

An alternative might be:
Rich (BB code):
    'Replace this
    Const WHAT_TO_FIND As String = "Net Total"
    Set FoundCell = ws.Range("B:C").Find(What:=WHAT_TO_FIND, MatchCase:=False)
    If FoundCell Is Nothing Then
        MsgBox "The search term: " & WHAT_TO_FIND & "  was not found"
        Exit Sub
    End If
    data_lastrow1 = FoundCell.Row

    'With this
    Dim rowNetTotal As Long
    Const WHAT_TO_FIND As String = "Net Total"
    With Application
        rowNetTotal = .IfError(.Match("Net Total", ws.Range("B:B"), 0), 0)
    End With
    
    If rowNetTotal = 0 Then
        MsgBox "The search term: " & WHAT_TO_FIND & "  was not found"
        Exit Sub
    End If
    
    data_lastrow1 = rowNetTotal

Data from your file:
20240701 VBA Find error 91 rtr1811.xlsm
ABCDEFGHIJKLMNOP
3073910090101
308Sub Total17519723173194
309ADD 110192323
310ADD 210192525
311Sub Total4848
312DEL 210092020
313Sub Total2020
3149th Ward Grand Total17720500002301752020
315Net Total15591625000065820149415430
Wardwise
Cell Formulas
RangeFormula
N307:O307,N309:O310,N312:O312N307=E307-(H307+K307)
N308:O308,K308:L308,E308:F308N308=SUM(N284:N307)
N311:O311,E311:F311N311=SUM(N309:N310)
N313:O313,E313:F313N313=SUM(N312)
E314:P314E314=E308+E311-E313
E315:P315E315=E47+E79+E118+E149+E187+E217+E261+E283+E314
The Same Message Box is displayed ie Runtime error is not resolved. If you have downloaded the file can you please help me some other requirements with the same file? I've given the requirements below.

In the sorted Wardwise Sheet After Each ward (The number in Column D defines Ward)

1. Insert one row for Summing up the rows above (Merge first three cells and Call this as 1st Ward Sub Total (may be named accodrding to the Ward Number))

2. Below this Main Roll Total, Add a row for Additional Total, if there exists Addition, merge the first three cells of the row ( Name this as 1st Ward Additional Total and sum up the rows just above this row)

3. Add a row below this row and call it as Deletion Total if there exists Deletion, merge the first three cells of the row ( Name this as 1st Ward Deletion Total and sum up the rows just above this row)

4. Below this Deletion Row Add a row and call it as Ist Ward Grand Total. In this row the formula should be Ist Ward Sub Total + Ist Ward Additional Total - Ist Ward Deletion Total )

Repeat this for each and every ward (Please note that No.of Wards is not fixed and do not hard code it. Also Addition and Deletion may not be avaliable for all the wards . If it is there a row must be inserted to include in the calculation, otherwise no need to insert a row)

5. After completion of above procedure for all the wards a row at the bottom should be inserted and named it as Net Total. In this row Grand Total of all the wards should be added.

6. Print Area should be set from Columns B to P.

7. Page Break should be set after Grand Total of Each Ward.

8. Any Blank rows after the Net Total Row should be deleted.

Thanks in advance.
 
Upvote 0
If you are saying that it is still not finding the Net Total then give this a try.
I have swapped Find for Match.
I'm afraid you would need to start a new thread for your other questions.

Rich (BB code):
Sub MergeSheets5_Match()

    Dim wsD As Worksheet
    Dim ws As Worksheet
    
    Set wsD = ThisWorkbook.Sheets("Wardwise")
    
    'delete previous data
    'wsD.Range("B6:R10000").Clear
    
    Dim data_lastrow As Long
    Dim FoundCell As Range
    Dim data_lastrow1 As Long
    
    
    For Each ws In ThisWorkbook.Worksheets
    If ws.Name = "Wardwise" Then
    Else
        'unmerge all cells
        ws.Range("B8:R10000").UnMerge
        
        
        'count the lastrow of each sheets
        data_lastrow = wsD.Cells(Rows.Count, 4).End(xlUp).Row + 1
        
        'Find net total as last row
        Dim rowNetTotal As Long
        Const WHAT_TO_FIND As String = "Net Total"
        With Application
            rowNetTotal = .IfError(.Match(WHAT_TO_FIND, ws.Range("B:B"), 0), 0)
        End With
        
        If rowNetTotal = 0 Then
            MsgBox "The search term: " & WHAT_TO_FIND & "  was not found"
            Exit Sub
        End If
        
        data_lastrow1 = rowNetTotal
        
        'copy sheets into Destination sheet
        ws.Range("C8:Q" & data_lastrow1).Copy Destination:=wsD.Range("D" & data_lastrow)
        ws.Range("B8:B" & data_lastrow1).Copy Destination:=wsD.Range("B" & data_lastrow)
        
        wsD.Range("C" & data_lastrow & ":C" & data_lastrow + data_lastrow1 - 8).Value = ws.Name
        
        End If
    Next ws
    
    data_lastrow = wsD.Cells(Rows.Count, 3).End(xlUp).Row + 1
    
    'remove row contains TOTAL
    Dim d As Long 'row number
    d = 6
    Do Until d = data_lastrow 'loop through each row
        If wsD.Cells(d, 2).Value Like "*" & "Total" & "*" Then
            wsD.Rows(d).EntireRow.Delete
        Else
            d = d + 1
        End If
    Loop
    
    'refresh last row of destination sheet
    wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("C5"), Order1:=xlAscending, Header:=xlYes
    wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlYes
    wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("D5"), Order1:=xlAscending, Header:=xlYes
    
    wsD.AutoFilterMode = False
    
    Set wsD = Nothing
    Set ws = Nothing

MsgBox "Done merged"

End Sub
 
Upvote 0
I have created a new thread. Can you please have a look at the following thread?

 
Upvote 0

Forum statistics

Threads
1,220,965
Messages
6,157,119
Members
451,398
Latest member
rjsteward

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top