I was unable to find a similar question to this. Basically, I have an excel macro that I have ran probably hundreds of times and has been working fine up until today. Today, when I run it, I get a run-time error 91, object block not set.
The issue begins at this statement: quidTab.AutoFilter.Sort.SortFields.Clear
Does anybody have any advice? I am truly lost
Here is the code:
' Remove The flags that have not triggered on this QUID.
Sub RemoveEmptyFlags()
'
' removeEmptyFlags2 Macro
'
Dim filterRow As Integer, notTriggeredFlagRow As Integer, quidTab As Worksheet
Range("A1").Select
Cells.Find(What:="CE_", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
filterRow = ActiveCell.Row - 1
Rows(CStr(filterRow) & ":" & CStr(filterRow)).Select
Selection.AutoFilter
Set quidTab = ActiveWorkbook.ActiveSheet
quidTab.AutoFilter.Sort.SortFields.Clear
quidTab.AutoFilter.Sort.SortFields.Add _
Key:=Range("C" & CStr(filterRow)), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortTextAsNumbers
With quidTab.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' Find the start of the flags that have not triggered, and delete down.
Range("C" & CStr(filterRow)).Select
Cells.Find(What:="2", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
notTriggeredFlagRow = ActiveCell.Row
If ActiveCell.Row > filterRow Then
Rows(CStr(notTriggeredFlagRow) & ":" & CStr(ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count)).Select
Selection.Delete Shift:=xlUp
End If
Range("A1").Select
End Sub
Related
This question already has answers here:
Cells.Find() Raises "Runtime Error 91: Object Variable or With Block Not Set"
(5 answers)
Closed 2 years ago.
When I skip through the sub where it shows the problem, this happens:
I can't seem to resolve the Issue since i use the code snippet from this sub multiple times and it works fine.. Code here
Private Sub UserForm_Initialize()
Sheets("Data").Range("A:T").AutoFilter Field:=18
Sheets("Data").Range("A:T").AutoFilter Field:=18, Criteria1:="FALSCH"
ActiveWorkbook.Worksheets("Data").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Data").AutoFilter.Sort.SortFields.Add Key:=Range( _
"I:I"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Data").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim lRow As Long
Dim lCol As Long
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
The structure should be something like this:
Dim ws As Worksheet
Set ws = Worksheets("Data")
Dim FoundAt As Range
Set FoundAt = ws.Cells.Find(What:="*", _
After:=ws.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not FoundAt Is Nothing Then
Dim lRow As Long
lRow = FoundAt.Row
'your other code here …
Else
MsgBox "Find failed!"
End If
First try to find the cell with ws.Cells.Find and reference it to a range variable FoundAt so you can test if a cell was found or not using If Not FoundAt Is Nothing Then, because .Row only exists if a cell was found. If you found nothing then nothing has no row (obviously).
I am stuck with a rather complex search and replace function, which is made up of one large table with 3 columns defining the 1) sheet where to SnR, 2) search term, 3) replacement word. I am testing on a Test sheet with 10 entries, but cant get the script to process any of the cells in range...
Sub FART_find_and_replace_text()
Dim sheet_name, label_old, label_new As String
Dim i As Integer
Dim sheetrng As Range
Set sheet_rng = Range(Sheets("Test").Range("B65536").End(xlUp), Range(Sheets("Test").Range("B5"))) 'all queries
'Set sheet_name = Range(Sheets("Test").Range("B65536").End(xlUp), Range(Sheets("Test").Range("B5"))) 'sheet name
'Set label_old = Range(Sheets("Test").Range("D65536").End(xlUp), Range(Sheets("Test").Range("D5"))) 'search term
'Set label_new = Range(Sheets("Test").Range("E65536").End(xlUp), Range(Sheets("Test").Range("E5"))) 'replacement
i = 0 'set counter to 0
For Each cell In sheet_rng
With ThisWorkbook.Sheets(cell.Value)
.Activate
.Cells.Find(What:=cell.Offset(0, 2).Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
.ActiveCell.Replace What:=cell.Offset(0, 2), Replacement:=cell.Offset(0, 3), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
i = i + 1
Next
End Sub
I am running Office on MAC which I have been told is not great with VBA, but I sadly have no choice and appreciate all the help I can get.
Thank you
EDIT:
here a screenshot of my sample data
Note: my sheet name is in A, search value in C and replace value in D
Looks like your data is in B, D and E columns.
Following is the macro for A, C and D columns.
Sub FindReplaceMutiValMutiSheet()
Dim FRdata As Range, TempSh As Worksheet, TempData As Range, FRarr
LRow = Range("A" & Rows.Count).End(xlUp).Row
Set FRdata = Sheets("Sheet1").Range("A1:D" & LRow)
'Copy FRData to temporary sheet and assign it to TempData
Set TempSh = Sheets.Add(, Sheets(Sheets.Count))
TempSh.Range("A1").Resize(FRdata.Rows.Count, FRdata.Columns.Count).Value = FRdata.Value
Set TempData = TempSh.Range("A1:D" & LRow)
'Sort TempData on "Sheet Name" (A) and "Search" (C) Columns
With TempSh.Sort
.SortFields.Add2 Key:=Range(TempData(1, 1), TempData(TempData.Rows.Count, 1)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add2 Key:=Range(TempData(1, 3), TempData(TempData.Rows.Count, 3)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range(TempData.Address)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Array of TempData Values
FRarr = TempData.Value
'Delete TempSh as no longer required.
Application.DisplayAlerts = False
TempSh.Delete
Application.DisplayAlerts = True
'Find and replace loop basded on FRarr array
For i = 2 To UBound(FRarr, 1)
If ActiveSheet.Name <> FRarr(i, 1) Then Sheets(FRarr(i, 1)).Activate
Range("A1").Activate
Cells.Replace What:=FRarr(i, 3), Replacement:=FRarr(i, 4), LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next
End Sub
Tested it on following sample data; works fine.
Hi have a report that is generated automatically and I want to create a macro that formats the report into something I can use as a database on our network drive. The report generates 2 tables that I want to streamline into 1 table. How do I find the range of the 2nd table when the 2nd table is never in exactly the same place due to the number of rows in each table changing daily.
If it helps, there is a unique header in the second table named "Potential Locations" which is the last row of the 2nd table.
I'm not really sure where to start with this code.
I basically want to run the macro to find the 2nd table and select it, delete the headers then move it 2 rows up and 2 columns to the right.
Thanks for the help, I got there in the end, see code below for how I resolved my issue.
Sub FORMAT_CUSTOMER_ORDER_REPORT()
'
' FORMAT_CUSTOMER_ORDER_REPORT Macro
' RE-ORGANISES CUSTOMER ORDER CLEANUP REPORT AND SAVES TO SHARED DRIVE IN FORRECT FILE FORMAT
'
'Code below adjusts column widths and deleted first row
Columns("A:A").ColumnWidth = 5.14
Columns("C:C").ColumnWidth = 10
Columns("D:D").ColumnWidth = 10.86
Columns("E:E").ColumnWidth = 4.14
Columns("G:G").ColumnWidth = 43.43
Columns("H:H").ColumnWidth = 5.14
Columns("I:I").ColumnWidth = 3.43
'Deletes top row.
Rows("1:1").Select
Selection.Delete Shift:=xlUp
'Code below finds and selects the cell with "POTENTIAL" in it.
Cells.Find(What:="POTENTIAL", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False).Activate
'Code below 'cuts' the 'current region'.
ActiveCell.CurrentRegion.Cut
'Code below pastes clipboard to the first blank cell in Column C.
Range("C1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
'Code below selects "current region" which in this case is the entire sheet
ActiveCell.CurrentRegion.Select
'Code below finds and selects the cell with "POTENTIAL" in it.
Cells.Find(What:="POTENTIAL", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False).Activate
'Code below select entire row of currently selected cell.
ActiveCell.EntireRow.Select
'Deletes selection
Selection.Delete Shift:=xlUp
'Selects 'current region'.
ActiveCell.CurrentRegion.Select
'Code below freezes first row
Rows("1:1").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Cells.Select
Sheet1.Sort.SortFields.Clear
Sheet1.Sort.SortFields.Add2 Key:= _
Range("B1:B2931"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With Sheet1.Sort
.SetRange Range("A1:N10000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=-6
'Code below Sorts entire sheet by Column B, A - Z.
Sheet1.Sort.SortFields.Clear
Sheet1.Sort.SortFields.Add2 Key:= _
Range("B1:B10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With Sheet1.Sort
.SetRange Range("A1:N10000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Code Below Saves File to network shared drive with the correct name
ActiveWorkbook.SaveAs Filename:= _
"R:\6024 Onsite\ONSITE CUSTOMER ORDERS\6024 CUSTOMER REPORT.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
I have a column with different numeric values. Some have format:
0.56
1.52
and some have format like:
6,352.00
To do calculations in excel i would like to substitute "," with "" when the number format is like 6,352.00 and to all the rest substitute "." with ",".
so in the result i should get:
0,56
1,52
6352,00
Then to sort them from Max to Min.
I tried to write a VBA code (that is not really correct), maybe some one can help with that?
Sub ChangeFormat1()
Dim lngNumberOfCharacters As Long
Set ws4 = ActiveWorkbook.Sheets("atm_hh")
ws4.Select
Columns("C:C").Select
lngNumberOfCharacters = Len("C:C")
If lngNumberOfCharacters > 8
Selection.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Else
Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
ActiveWorkbook.Worksheets("atm_hh").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("atm_hh").Sort.SortFields.Add Key:=Range("C1"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("atm_hh").Sort
.SetRange Range("A2:D66842")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
If you really want to work with VBA
Sub ChangeFormat1()
Application.ScreenUpdating = False
Dim ws4 As Worksheet
Set ws4 = Sheets("atm_hh")
' If you only want to replace in column A for example
With ws4.Columns("A:A")
.Replace What:=",", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
.Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End With
Application.ScreenUpdating = True
End Sub
Hi i am writing a code in vb to check a particular value in a sheet, if the value is not available then it should go back to another sheet to take new value to find, if the value is found i have to do some operation on that sheet i have the below code to find the value in the sheet but if i pass the same in a DO WHILE loop as condition it gives a compile error
find vaue code
Selection.Find(What:=last_received, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
could some one please help me to write a code of DO WHILE with the above find in the loop condition so that if the condition gives false (i,e if the value is not found in the sheet) then i should use some other value to find
this is the code that i am going to put in loop
Sheets("Extract -prev").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Extract -prev").Sort.SortFields.Clear 'sorting with tickets
ActiveWorkbook.Worksheets("Extract -prev").Sort.SortFields.Add Key:=Range( _
"C2:C2147"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Extract -prev").Sort
.SetRange Range("A1:AB2147")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.Goto Reference:="R1C3" 'taking last received ticket
Selection.End(xlDown).Select
Selection.Copy
Sheets("Calc").Select
Application.Goto Reference:="Yesterday_last_received"
ActiveSheet.Paste
this code takes the last ticket but based on it's availablity in next sheet "extract" i have to take one ticket previous to the last one (and on).
Try below code :
Sub test()
Dim lastRow As Long
Dim rng As Range
Dim firstCell As String
lastRow = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lastRow
Set rng = Sheets("sheet2").Range("A:A").Find(What:=Cells(i, 1), LookIn:=xlValues, lookAt:=xlPart, SearchOrder:=xlByRows)
If Not rng Is Nothing Then firstCell = rng.Address
Do While Not rng Is Nothing
rng.Offset(0, 1) = "found"
Set rng = Sheets("sheet2").Range("A:A").FindNext(rng)
If Not rng Is Nothing Then
If rng.Address = firstCell Then Exit Do
End If
Loop
Next
End Sub