VBA help Object variable not set (Error 91)

[justme1122]

Hi guys

Sorry, im rather new to VBA and having a little bit of a problem with this error:

Object variable not set (Error 91)

From my understanding something s missing from the top few lines but im unsure how to fix it.

Sub Shift_Data()
    Dim Found           As Range, col As Long, Lastrow As Long
    Dim ws              As Worksheet
    
    
    Application.ScreenUpdating = False
    For Each ws In Worksheets
        col = 1
        Set Found = ws.Columns(col).Find("SubTotal", , xlValues, xlWhole, xlByRows, xlNext, False)
        If Not Found Is Nothing Then
            Lastrow = ws.Range("k" & Rows.Count).End(xlUp).Row
            If Found.Row <> Lastrow Then
                Do
                    ws.Range(Found.Offset(1), ws.Cells(Lastrow, col)).Insert Shift:=xlToRight
                    col = col + 1
                    Set Found = ws.Columns(col).Find("SubTotal")
                Loop Until Found.Row = Lastrow
            End If
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

There line that debug highllights is in red.

Thanks so much for any help
scott

 

[baitmaster]

My big concern here is that when you try to move everything 1 column to the right, you are eventually going to overwrite something incorrectly. For example, the algorithm as I believe you currently want it, will move the Grand Total incorrectly, and potentially lose some of your totals

As I now understand your requirement, it is to try and support a database-type approach, so you can filter by e.g. Nintendo but in a subcategory. Your current plan is to move the cells to create column subcategories, I wouldn't do this, I would think about adding the subcategory (Stock, Ex-Rental, Rental etc) in column B instead. You could then use the combination of the 2 to filter by whichever result you want. I think this will be more robust going forward, and less dangerous

VLOOKUP might not work, but an alternative could be found that answers whatever question you want, as long as the right category and subcategory exist. For example, you might need INDEX, MATCH, SUMPRODUCT or SUMIFS to answer the question

the following example applies sub-categories to the first example sheet provided, without restructuring it. You may need to adjust the range you are looking at if there is more data on the sheet. The Options need to sit at the top of your code module. You also need to replace activesheet with your "for each ws" construct, this example is for one sheet only, to see if you could use this approach

Option Explicit
Option Compare Text
 
Sub writeSubCats()
Dim cl As Range
Dim strCurrentCategory As String
For Each cl In ActiveSheet.UsedRange.Columns(1).Cells
    Select Case cl.Value
        Case "stock", "ex-rental", "rental", "sell through", "overdues collected" ' add new categories here when needed
            strCurrentCategory = cl.Value
        Case "subtotal", "grand total", ""
            ' no action for these categories
        Case Else
            cl.Offset(0, 1) = strCurrentCategory
    End Select
Next cl
End Sub

 

[justme1122]

Thank you so much.

This is a more logical aproach that I had not considered.

one last question if I may,

How would i go about making the script end when it when it gets to the cell with the text "grand total".

scott

 

[baitmaster]

    Select Case cl.Value
        Case "stock", "ex-rental", "rental", "sell through", "overdues collected" ' add new categories here when needed
            strCurrentCategory = cl.Value
        Case "subtotal", ""
            ' no action for these categories
        Case "grand total"
            exit for ' or exit sub
        Case Else
            cl.Offset(0, 1) = strCurrentCategory
    End Select

The Select Case statement is like a glorified IF, allowing you to add as many different choices in simply and neatly

 

[justme1122]

ARRRRR,, so close.

So I think this script is working but it gives me an error on the last sheet. I think im missing something to stop my loop script when it gets to the last worksheet

Any idea's?

thanks

Option Explicit
Option Compare Text
 
Sub writeSubCats()
Dim cl                  As Range
Dim strCurrentCategory  As String
Dim i                   As Long
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
 
 
For i = 2 To Worksheets.Count
Sheets(i + 0).Select
 
    For Each cl In ActiveSheet.UsedRange.Columns(1).Cells
        Select Case cl.Value
            Case "stock", "ex-rental", "rental", "sell through", "overdues collected" ' add new categories here when needed
                strCurrentCategory = cl.Value
            Case "subtotal", ""
                ' no action for these categories
            Case "grand total"
                Exit For ' or exit sub
            Case Else
                cl.Offset(0, 1) = strCurrentCategory
        End Select
    Next cl
 
Next
 
 
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[justme1122]

getting closer:

So this script will do exactly what I want it to on one sheet and then select the next sheet. But how do I get it to start over on the new sheet?

Option Explicit
Option Compare Text
 
Sub writeSubCats()
Dim cl As Range
Dim strCurrentCategory As String
  
        For Each cl In ActiveSheet.UsedRange.Columns(1).Cells
            Select Case cl.Value
                Case "stock", "Ex-rental                                         ", "Rental                                            ", "Sell Through                                      ", "overdues collected"        ' add new categories here when needed
                    strCurrentCategory = cl.Value
                Case ""
                    ' no action for these categories
                Case "Grand Total"
                    ActiveSheet.Next.Select
                    Exit For
                Case Else
                    cl.Offset(0, 1) = strCurrentCategory
            End Select
        
        Next cl
End Sub

thanks

 

[justme1122]

3 hours later and all im missing is a way to stop the error message when I get to the last sheet. My error is because im using ActiveSheet.Next.Select with out any end point. any suggestion on how I could get a if last sheet end sub in?

Option Explicit
Option Compare Text

Sub B_writeSubCats()
Dim strCurrentCategory As String
Dim cl As Range
Dim ws As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
For Each ws In Worksheets
 
ActiveSheet.Next.Select
 
For Each cl In ActiveSheet.UsedRange.Columns(1).Cells
Select Case cl.Value
Case Cells(1), Cells(2), Cells(3)
' no action for these categories
Case "stock", "Ex-rental ", "Rental ", "Sell Through ", "overdues collected" ' add new categories here when needed
strCurrentCategory = cl.Value
Case ""
' no action for these categories
Case "Grand Total"
Exit For ' exit cl
Case Else
cl.Offset(0, 1) = strCurrentCategory
End Select
 
Next cl
 
Next ws
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets(1).Select
MsgBox ("ALL DONE")
End Sub

 

[shg]

Maybe ...

Sub writeSubCats()
    Dim iWks        As Long
    Dim cell        As Range
    Dim sCat        As String
 
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
 
        For iWks = 2 To Worksheets.Count
            For Each cell In Worksheets(iWks).UsedRange.Columns(1).Cells
                Select Case LCase(cell.Text)
                    Case "stock", "ex-rental", "rental", "sell through", "overdues collected"
                        sCat = cell.Text
                    Case "subtotal", ""
                        ' no action for these categories
                    Case "grand total"
                        Exit For
                    Case Else
                        cell.Offset(0, 1) = sCat
                End Select
            Next cell
        Next iWks
 
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub