The following code is to take data from the "raw" worksheet and copy to separate workbooks based on the initials of each coder. When the Excel document is open and the macro selected, I get a run-time error 91 "Object variable or With block variable not set" but when I run it a second time it works exactly as planned (so it runs correctly every other time it is selected). The error occurs on line 18: "set Rng = sht.range(sht.autofilter.range(columns(4).address)". Any assistance greatly appreciated.
VBA Code: Sub Coder_Own_Sheet() Dim Sht As Worksheet Dim Rng As Range Dim List As Collection Dim varValue As Variant Dim i As Long Dim filename As String Dim pathname Set Sht = ActiveWorkbook.Sheets("Raw") filename = "Cell Saver_" & Format(Sheets("General").Range("A1").Value, "MMM-yyyy") & "_" & varValue pathname = Sheets("General").Range("A2") With Sht.Range("A3") .AutoFilter End With Set Rng = Sht.Range(Sht.AutoFilter.Range.Columns(4).Address) Set List = New Collection On Error Resume Next For i = 2 To Rng.Rows.Count List.Add Rng.Cells(i, 1), CStr(Rng.Cells(i, 1)) Next i For Each varValue In List Rng.AutoFilter Field:=4, Criteria1:=varValue ' // Copy the AutoFiltered Range to new Workbook Sht.AutoFilter.Range.Copy Workbooks.Add Range("A1") = "Inpatient Case Review for Flagged Interventions - Cell Saver" Range("A2") = "Fix the error please" Range("A4").PasteSpecial xlPasteAll Range("A1").Font.Size = 16 Range("A1").Font.Bold = True Columns("A").ColumnWidth = 14 Columns("B:H").EntireColumn.AutoFit ActiveWorkbook.SaveAs filename:=pathname & filename & varValue & ".xlsx" ActiveWorkbook.Close savechanges:=True ' // Loop back to get the next collection Value Next varValue ' // Go back to main Sheet and removed filters Sht.AutoFilter.ShowAllData Sht.Activate End Sub
Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
-
2
The only way to replicate your issue is to NOT declare the variable: Rng. Are you using Option Explicit ?
-
3
Thanks for your response. No I wasn't using Option Explicit but adding it results the same...first attempt fails and second attempt works. Is there any other way to write this so it works on the first try?
"Runtime Error 91: Object variable or with block variable not set" is a runtime error that can happen on any Windows-based operating system version. The DCOMCnfg.exe file, which is frequently used to establish rights and set system-wide security settings, is usually the problem.
When this file becomes corrupted or other problems emerge, the programme becomes unusable, and Runtime Error 91 appears on the screen. However, there could be other causes for the problem, and we'll look at all the options for resolving Runtime Error 91.
Variable problems could be the result of file corruption. Users could utilise the built-in SFC scan to fix the faulty data in the system files. This procedure, however, will not work if the corrupted files are not those of Windows, but rather those of an external application, even if it is one of the PC's main programmes. As a result, you should attempt reinstalling the software that is causing the Runtime Error 91. Sub ClipboardToNote() Dim r As Range Dim rvDat As Range Dim tt As Range Dim wt As Range Dim C As Comment Dim CText As String Dim s As String Dim s0 As String Dim s1 As String Dim s2 As String Dim sHop As Worksheet Dim sTcka As Worksheet ' Set r = ActiveCell Set sHop = Sheets("Hop") 'SHEET IS ONLY USED AS A TEMPORARY PASTE FROM CLIPBOARD BEFORE PICKING RELEVANT DATA FOR THE NOTE' Set rvDat = sHop.Range("A1:A200") Set sTcka = Sheets("Ticker") Application.ScreenUpdating = False sHop.Activate rvDat.Clear Range("A1").Select ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True ' With rvDat Set tt = rvDat.Find("Total applications", LookIn:=xlValues) s1 = Replace(tt, "Total applications", " total") ''INTERMITENT ERROR ON THIS LINE Set wt = rvDat.Find("Applications awaiting response", LookIn:=xlValues) s2 = Replace(wt, "Applications awaiting response", " awaiting") Set cp = rvDat.Find("Applications accepted", LookIn:=xlValues) End With ' sTcka.Activate s = "" With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") On Error Resume Next .GetFromClipboard s = .GetText On Error GoTo 0 End With If Trim(s) <> "" Then On Error Resume Next Set C = r.AddComment On Error GoTo 0 If C Is Nothing Then 'already has a comment Set C = r.Comment CText = C.Text & vbCrLf & "--------" & vbCrLf & s1 & vbCrLf & s2 & vbCrLf & "[" & Format(VBA.Now, "DD/MMM/YY hh:mm") & "]" C.Text CText C.Shape.TextFrame.AutoSize = True Else 'make new comment CText = s1 & vbCrLf & s2 & vbCrLf & "[" & Format(VBA.Now, "DD/MMM/YY hh:mm") & "]" C.Text CText C.Shape.TextFrame.AutoSize = True End If End If End Sub