I am struggling to create a code to search for a value within a workbook that I am accessing without bringing it to the foreground. I am using the following code to access the file as "xl0":
'DATABASE ACCESS
Dim xl0 As New Excel.Application
Dim xlw As New Excel.Workbook
Dim db_directory As String
db_directory = "R:\New Quality Management System\xls\Supplier Non-Conformance\Supplier Non-Conformance Database.xlsm"
Set xlw = xl0.Workbooks.Open(db_directory)
I have successfully had this working to add records to the xl0 spreadsheet however I also need to create a modify record macro to "find" an index value and extract the row number. I tried several variations (2 examples below) with no success, can anyone advise?
Eg 1.
Windows("Supplier Non-Conformance Database.xlsm").Activate
Cells.Find(What:="2015-16-46", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Eg 2.
xl0.Worksheets("SNCR Log").Range("B:B").Find(What:="2015-16-46",
After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Thanks in advance,
Dan
Here is a start :
(btw, the activation is really greedy in resources, so try to avoid it as much as possible!)
Application.ScreenUpdating=False
'DATABASE ACCESS
Dim xl0 As New Excel.Application
Dim xlw As New Excel.Workbook
Dim db_directory As String
xl0.Visible=False
db_directory = "R:\New Quality Management System\xls\Supplier Non-Conformance\Supplier Non-Conformance Database.xlsm"
Set xlw = xl0.Workbooks.Open(db_directory)
MsgBox xlw.Sheets(1).Cells.Find(What:="2015-16-46", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
Application.ScreenUpdating=True
Related
I'm new to VBA. I want to find the headers of six columns and join them using the union method. Once they are joined as BigColumns, I want to change the font size to 14.
I've already tried looping, but given that I am new to this I wanted to try a simpler way. I can successfully run this code on one range, such as TC1, and change the font to 14. But as soon as I try combining ranges, it fails.
Sub ASOLDPrintFormatTesting2()
Dim Table As Range
Dim BigColumns As Range
Dim TC1, TC2, TC3, TC4, TC5, TC6 As Range
'TC stands for Table Columns These individual ranges are joined through
Union Method
Set ReferenceCell = ActiveCell
Set WS = Sheets(2)
With WS
Set ReferenceCell = Cells.Find(What:="Source #", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'Make Source # the Reference Cell, or the equivalent of A1
If Not ReferenceCell Is Nothing Then
Set ReferenceCell = Cells.Find(What:="Sample #", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End If
'Make Sample # the Reference Cell
Set Table = ReferenceCell.CurrentRegion
With Table
Set TC1 = .Find(What:="Source Well", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set TC2 = .Find(What:="Sample ID", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set TC3 = .Find(What:="VerboseConc_uM", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set TC4 = .Find(What:="VerboseConc_ug/ml", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set TC5 = .Find(What:="Mol Wt.", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set TC6 = .Find(What:="N/Mole", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'Find all headers of BigColumns
Set BigColumns = Application.Union(Range("TC1"), Range("TC2"), _
Range("TC3"), Range("TC4"), Range("TC5"), Range("TC6"))
'Union of all headerrs as BigColumns
If Not BigColumns Is Nothing Then
Else
MsgBox "'BigColumns' not found"
Exit Sub
End If
End With
With BigColumns
.Cells.Font.Size = 14
End With
'Test to see if BigColumns works
End With
End Sub
No error messages are produced when the code runs.
Using an array (will give a snippit example), you should be able to loop and save some time and possible issues where things are not found:
dim arr as variant, i as long
arr = array("Source Well","Sample ID") 'can add more
with table
for i = lbound(arr) to ubound(arr)
set f = .find(what:=arr(i))
if not f is nothing then f.font.size = 14
next i
end with
-untested code-
You find your item, if it's not found it skips changing the font size.
I have an excel file that has the text "Income from Trans" where I will need to delete the entire column.
This is my current code in VBA 2010 that works until there are no more cells with "Income from Trans"; I can't get it to break out of the loop.
Any idea why?
Dim rng1 As Range
Dim target1 As String
target1 = "Income From Trans"
Set rng1 = Cells.Find(What:=target1, _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Do Until rng1 Is Nothing
Cells.Find(What:=target1, After:=ActiveCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection _
:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.EntireColumn.Delete
Loop
Your code Set rng1 = Cells.Find... will set rng1 to be a range object, assuming it finds your value. Next is your loop which will ultimately cause rng1 to be deleted. It continues to loop because even though rng1 is deleted it still was assigned and therefore isn't Nothing. It ends with an run time error message of 91 because rng1 was set but deleted. You can see in the locals window View>Locals Window that its type is still Range\Range even though it's actually been deleted.
You have implicit cell references from the unqualified Cells usage. That means this code will run on whatever worksheet happens to be the ActiveSheet. Implicit references can have unintended side effects when you don't realize this. It's best to fully qualify them so there's no ambiguity as to which sheet they reside on. I'm assuming ActiveCell falls into this category too since you want it to wrap delete until there "Income from Trans" is no longer found.
The code .Activate followed by ActiveCell. isn't needed and can be shortened by removing both so it ends up as SearchFormat:=False).EntireColum.... Selecting a range object isn't usually necessary. Joining the two makes it apparent what you're doing.
Below you'll find a simpler version that uses .Find is in your original to find the first instance. After that it uses .FindNext() to continue looping until all are found. This eventually exits because it is setting the range variable found after every deletion, ultimately leaving found as Nothing after it's deleted the last. The RemoveColumns has parameters which allow you to use this on more than just a single sheet.
Sub Test()
RemoveColumns Sheet1, "Income From Trans"
End Sub
Sub RemoveColumns(ByVal sheetToSearch As Worksheet, ByVal value As String)
Dim found As Range
Set found = sheetToSearch.Cells.Find(What:=value, After:=sheetToSearch.Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
Do Until found Is Nothing
found.EntireColumn.Delete
Set found = sheetToSearch.Cells.FindNext
Loop
End Sub
Check the search result inside the loop as well
Dim rng1 As Range, target1 As String, firstFound As String
target1 = "Income From Trans"
Set rng1 = Cells.Find(What:=target1, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not rng1 Is Nothing Then
Do
firstFound = rng1.Address
Set rng1 = Cells.Find(What:=target1, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
If Not rng1 Is Nothing Then rng1.EntireColumn.Delete
Loop While Not rng1 Is Nothing And rng1.Address <> firstFound
End If
I have the code below (loop) to search for 0's in my spreadsheet (Column D) when it finds one if performs a copy/paste and then deletes the row. After all the filtered 0's (the column is filtered by column A - duplicates) I tell it to end sub. But I found the find is finding the 0's in the filtered hidden rows so the loop keeps going.
How can make the find only work on the visible rows and then end when all the 0's have been dealt with.
Set RangeObj = Cells.Find(What:="0", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If RangeObj Is Nothing Then RangeObj.Activate
Cells.Find(What:="0", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
What you need is the SpecialCells(xlCellTypeVisible) method and the .FindNext method.
See the below code:
Set RangeObj = Cells.SpecialCells(xlCellTypeVisible).Find(What:="0", After:=Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not RangeObj Is Nothing Then
Dim sFirstAdd As String, sAdd As String
sFirstAdd = RangeObj.Address
Do
sAdd = RangeObj.Address
With RangeObj.EntireRow 'or limit to just the necessary columns
.Copy 'choose your desired destination
.Delete
End With
Set RangeObj = Cells.SpecialCells(xlCellTypeVisible).FindNext(After:=Range(sAdd))
Loop Until RangeObj Is Nothing Or sAdd = sFirstAdd
End If
I have this code as an excel macro.
Dim MyData As DataObject
Set MyData = New DataObject
MyData.GetFromClipboard
MsgBox MyData.GetText
On Error GoTo NotFound
Cells.Find(What:=MyData.GetText, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
NotFound:
MsgBox writes the value correctly, but the What:=MyData.GetText just won't work. Why? Or, more importantly, how to fix it?
If it is not clear, I am trying to find the next value equal to the one in clipboard at the moment. I have referenced the MSForms so that is not the problem.
If I assign MyData.GetText to a variable and use the variable, the same happens, MsgBox works, BUT What:=myvariable doesn't.
Not sure why this works, but it does:
Sub test()
Dim MyData As DataObject
Dim rng As Excel.Range
Set MyData = New DataObject
MyData.GetFromClipboard
Set rng = ActiveSheet.Cells.Find(What:=MyData.GetText, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
rng.Activate
End Sub
This question already has answers here:
how to detect whether VBA excel found something?
(3 answers)
Closed 7 years ago.
I receiving a strange error when running this subroutine in VBA:
Sub NameColumns()
' name key columns for later reference in formulas
Dim startdatecol As Integer
' name start date column
startdatecol = ActiveSheet.Cells.Find(What:="Start Date", after:=[a1], LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Column
End Sub
Run time error '91': Object variable or With variable not set
Any ideas on how I can fix this subroutine error? And why it is occurring?
Thanks,
AME
The problem is that Find is not finding the cell.
You will find (pun intended) that the following is true:
MsgBox ActiveSheet.Cells.Find(What:="Start Date", after:=[a1], LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False) Is Nothing
The first thing you should do is fix your search so that it finds the cell you're looking for.
Edit:
Maybe a change that would better illustrate the problem is this:
Dim found as Range
Dim startDateCol as Integer
Set found = ActiveSheet.Cells.Find(What:="Start Date", after:=[a1], LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not found Is Nothing Then startDateCol = found.Column
MsgBox startDateCol 'This will be zero if the "Start Date" cell wasn't found.
Edit to respond to comment:
'This should find the exact text "Start Date" (case sensitive) in the header row.
'A cell containing, for example "The Start Date" will not be matched.
Set found = ActiveSheet.Range("1:1").Find("Start Date", LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=True)