Excel VBA Return the found row - excel

Right now I have this:
Range("B20:B60000").Select
Selection.Find(What:=currentPerson, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Which selects a certain range of cells and finds for currentPerson (variable containing a person's name). How do I make it so that I can now use his cell as a reference and get the row above him?

You can use following code:
Dim res As Range
Set res = Range("B20:B60000").Find(What:=currentPerson, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
If Not res Is Nothing Then
MsgBox "Address: " & res.Address
MsgBox "Row: " & res.Row
MsgBox "Cell above: " & Cells(res.Row - 1, res.Column).Address
MsgBox "Entire row above: " & Cells(res.Row - 1, res.Column).EntireRow.Address
Else
MsgBox "Nothing found"
End If

Related

receive runtime error while running loop ran fine fefor dont know why erroring out now

Sheets("SE Export").Activate 'calls active sheet
LastSERow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Range("A7").Activate
If ("A7") = 1 Then
Range("A6").Activate 'Active column A6
'On Error GoTo QS_MPN_Error
Cells.Find(What:="CPN").Activate
On Error GoTo 0
End If
ActiveCell.Offset(0, 0 - (ActiveCell.Column - 1)).Activate
'End If
QSMapForm.Show
Cells.Find(What:="Lifecycle").Activate 'Find lifecycle header
ActiveCell.Offset(1, 0).Activate
Do
If ActiveCell = "" Then 'Runs through each column for lifecycle status
ActiveCell = "Unmatched Part"
ElseIf InStr(ActiveCell, "Preliminary") Then 'If part is preliminary then change status to conditional
ActiveCell = "Conditional Availability"
ElseIf InStr(ActiveCell, "Obsolete") Then
If InStr(ActiveCell.Offset(0, 3), "") Then
ActiveCell = "Discontinued-W/Alternates"
Else
ActiveCell = "Discontinued-No Alternates"
End If
ElseIf InStr(ActiveCell, "LTB") Then
ActiveCell.Offset(0, 8) = ActiveCell
ActiveCell.Replace What:="LTB", Replacement:="", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveCell.Replace What:="(", Replacement:="", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveCell.Replace What:=")", Replacement:="", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveCell.Replace What:=Chr(10), Replacement:="", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
LTBdate = ActiveCell
ActiveCell.Offset(0, 16) = LTBdate
ActiveCell = "Life Time Buy"
End If
'I receive the error while running the next line it does not like the value of "" for some reason.
Loop While ActiveCell.Offset(0, -12).Value <> ""
'Error at the loop while with object defined, for the value of the next cell of "".
ActiveCell.Offset(1, 0).Activate 'I receive the error while running the next line it does not like the value of "" for some reason.
Code {Loop While ActiveCell.Offset(0, -12).Value <> ""}

Import Data from Access to Excel and do a conversion from $ to M$

Here is a question i have for importing data from Access to Excel.
So first I need to write data from Excel to Access (when the data is saved in Access, the data are saved as the access units by doing a unit conversion of the data from Excel).
After that, I may want to recall these data back into excel and the excel needs to convert the recalled data back into the base units of Excel.
That being said, for cells with money values, I assign these cells with a unit type of CURRENCY. When these data is saved in Access, they become $. But when they are recalled back into Excel, the base unit in excel is M$. I need to figure out a coding that let these cells value divided by 1000 so they become M$ in Excel. After that, I will have a droplist that let me convert these values to either $ or MM$ when i want to. The conversions for bbl and mcf are already done by original user.
Not sure if anyone can give me a easy solution for this...I have the code below:
Set rs2 = db.OpenRecordset("SELECT * FROM Project_Data WHERE LoadID = " & _
record_ID & " ORDER BY LoadID Asc", dbReadOnly)
For v = 1 To 1244
v_name = vars(v, 1)
If vars(v, 2) = "Y" Then
rs2.MoveFirst
Do
If rs2![VariableName] = v_name Then ' And rs2![LoadID] = record_ID Then
If Mid(v_name, 1, 2) = "T1" Then
Sheets("T1").Range(v_name) = Val(rs2![VariableValue])
End If
If Mid(v_name, 1, 2) = "T2" Then
Sheets("T2").Range(v_name) = Val(rs2![VariableValue])
End If
If Mid(v_name, 1, 2) = "T3" Then
Sheets("T3").Range(v_name) = Val(rs2![VariableValue])
End If
If Mid(v_name, 1, 2) = "T4" Then
Sheets("T4").Range(v_name) = Val(rs2![VariableValue])
End If
If Mid(v_name, 1, 2) = "T5" Then
Sheets("T5").Range(v_name) = Val(rs2![VariableValue])
End If
If Mid(v_name, 1, 2) = "T6" Then
Sheets("T6").Range(v_name) = Val(rs2![VariableValue])
End If
If Mid(v_name, 1, 2) = "T7" Then
Sheets("T7").Range(v_name) = Val(rs2![VariableValue])
End If
Exit Do
End If
rs2.MoveNext
Loop Until rs2.EOF
End If
Next v
rs2.Close
Set rs2 = Nothing
db.Close
Set db = Nothing
Unload Me
write_log ("Imported existing record.")
Sheets("Main").Range("GASUNITS") = "MMcf"
ThisWorkbook.gas_units = "MMcf"
Sheets("Main").Range("LIQUIDUNITS") = "Mbbl"
ThisWorkbook.liquid_units = "Mbbl"
Call Switch_Liquids_Units("Mbbl")
Call Switch_Gas_Units("MMcf")
MsgBox ("Data has been loaded.")
End Sub
Coding for switch_Liquids_Units:
Sub Switch_Liquids_Units(units)
If Range("LIQUIDUNITS") = "Mbbl" Then
pass_unit = "M"
pass_fluid = "Oil"
End If
If Range("LIQUIDUNITS") = "MMbbl" Then
pass_unit = "MM"
pass_fluid = "Oil"
End If
If Range("LIQUIDUNITS") = "bbl" Then
pass_unit = ""
pass_fluid = "Oil"
End If
Call Replace_Units(pass_unit, pass_fluid)
Sheets("Main").Select
If do_old = True Then
Sheets("T1").Select
'Rows("3:3").Select
Range("B3:AE3").Select
If units = "bbl" Then
Selection.Replace What:="(Mbbl)", Replacement:="(bbl)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(MMbbl)", Replacement:="(bbl)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(Mboe)", Replacement:="(boe)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(MMboe)", Replacement:="(boe)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
If units = "Mbbl" Then
Range("B3:AE3").Replace What:="(bbl)", Replacement:="(Mbbl)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(MMbbl)", Replacement:="(Mbbl)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(boe)", Replacement:="(Mboe)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(MMboe)", Replacement:="(Mboe)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
If units = "MMbbl" Then
Selection.Replace What:="(bbl)", Replacement:="(MMbbl)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(Mbbl)", Replacement:="(MMbbl)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(boe)", Replacement:="(MMboe)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(Mboe)", Replacement:="(MMboe)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
Sheets("T2").Select
'Rows("4:4").Select
Range("B4:AN4").Select
If units = "bbl" Then
Selection.Replace What:="(Mbbl)", Replacement:="(bbl)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(MMbbl)", Replacement:="(bbl)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
If units = "Mbbl" Then
Selection.Replace What:="(bbl)", Replacement:="(Mbbl)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(MMbbl)", Replacement:="(Mbbl)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
If units = "MMbbl" Then
Selection.Replace What:="(bbl)", Replacement:="(MMbbl)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(Mbbl)", Replacement:="(MMbbl)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End If
End Sub
To answer your titled question (unable to help with posted code), simply adjust SQL query for the needed conversion. Below shows how the SQL statement can be conditionally modified by needed units conversion. Integrate the below in appropriate sections of your code base. Also, avoid SELECT *. Instead, explicitly define columns for code readability and maintainability.
If unitVariable = "per thousand"
strSQL = "SELECT Col1 / 1E3 As Col1_in_thousands, " & _
" Col2 / 1E3 As Col2_in_thousands, " & _
" Col3 / 1E3 As Col3_in_thousands, " & _
" ... " & _
" FROM Project_Data " & _
" WHERE LoadID = " & record_ID & _
" ORDER BY LoadID ASC"
ElseIf unitVariable = "per million"
strSQL = "SELECT Col1 / 1E6 As Col1_in_millions, " & _
" Col2 / 1E6 As Col2_in_millions, " & _
" Col3 / 1E6 As Col3_in_millions, " & _
" ... " & _
" FROM Project_Data " & _
" WHERE LoadID = " & record_ID & _
" ORDER BY LoadID ASC"
ElseIf unitVariable = "per billion"
strSQL = "SELECT Col1 / 1E9 As Col1_in_billions, " & _
" Col2 / 1E9 As Col2_in_billions, " & _
" Col3 / 1E9 As Col3_in_billions, " & _
" ... " & _
" FROM Project_Data " & _
" WHERE LoadID = " & record_ID & _
" ORDER BY LoadID ASC"
End If
' PASS DYNAMIC SQL QUERY
Set rs2 = db.OpenRecordset(strSQL, dbReadOnly)
...
Aside: since MS Access is a database, you should be storing the most detailed precision of data in it and since Excel is an end-use reporting tool (not to be used for persistent data storage), simply convert to whatever units needed at the report side and in this case via the SQL query.

VBA .ClearContents for inserted Rows?

So I have a code that finds three rows and insert the same rows below them, but I need to clear contents of these inserted rows, unfortunately, the selecetion applies for the first three rows and not those inserted.
Sub Add_Timber()
'
' Add_Timber Macro
'
'
Cells.Find(What:="Timber | Zakázky:", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.EntireRow.Copy
Selection.Offset(3, 0).Insert Shift:=xlDown
Cells.Find(What:="Timber | JIRA ID:", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.EntireRow.Copy
Selection.Offset(3, 0).Insert Shift:=xlDown
Cells.Find(What:="Timber | Hodiny:", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.EntireRow.Copy
Selection.Offset(3, 0).Insert Shift:=xlDown
End Sub
So in picture a red block is copied from the previous and I want to delete the data in the NEW INSERTED rows.
Since rows are Always conscutive and in the same ordwer, then you could make copy/insert in one shot
Sub Add_Timber()
Dim f As Range
Set f = Cells.Find(What:="Timber | Zakázky:", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)' try finding "Timber | Zakázky:"
If Not f Is Nothing Then 'if succesfull
With f.Resize(3).EntireRow ' reference found cell row along with its two consecutive ones
.Offset(3).Insert ' insert referenced rows three rows below the referenced ones
.Copy .Offset(3) ' copy referenced rows three rows below
End With
End If
End Sub

ActiveCell Based Selection

Column A to H has data with some blanks in between. I want to find "ABC" in column A and then select 2 rows above - this will be my ActiveCell.
I want to delete rows in between ActiveCell to Row2 (Active Cell is Dynamic)
Sub format()
Cells.Find(What:="abc", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:= xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False).Activate
ActiveCell.Offset(-2, 0).Select
Range(Selection, ActiveCell, A2).Select
End Sub
The code will do the job for you:
Sub format()
Dim rng As Range
Set rng = Cells.Find(What:="abc", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
rng.Offset(-2, 0).Select
Range(Cells(Selection.Row, 1), Cells(2, 1)).Select
'Selection.EntireRow.Delete
End Sub
Currently I have commented out the last line which will delete the Rows you want. uncomment it, but first be sure that's what you want to delete.
For Range please try:
(ActiveCell, "A2").Select

Excel macro search ends in error when nothing found

My Case 1 excel macro code runs as long as data is being found by the search but bombs with the stated error when there is nothing in the search result. So I tried putting in a "set" see Case 2... but that Case bombs on any search.
CASE 1: Run-time error '91': Object variable or With block variable not set
Cells.Find(What:=sCurrentISOtext & "_", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt :=xlWhole , _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:= False, SearchFormat:=False).Activate
CASE 2: Run-time error '424': Object required
Dim c As Range
Set c = Cells.Find(What:=sCurrentISOtext & "_", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt :=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:= False, SearchFormat:=False).Activate
You mean like this?? It still fails.
CASE 3: Run-time error '91': Object variable or With block variable not set
Dim c As Range
c = Cells.Find(What:=sCurrentISOtext & "_", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole = 0, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
:=False, SearchFormat:=False)
If Not c Is Nothing Then
c.Activate
' and do something here < >
End If
This would naturally fail, you are calling "activate" on a null (failed) result - so there's nothing to activate at runtime. You have to wrap in an If statement -
Dim c As Range
Set c = Cells.Find(What:=sCurrentISOtext & "_", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlWhole = 0, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:= False, _
SearchFormat:=False)
If c Is Nothing Then
'do something
Else
c.Activate
End If
Here's an ugly work around that I use when I'm in a hurry -- there are more elegant error traps, but this gets it done.
On Error GoTo notFound
Dim c As Range
Set c = Cells.Find(What:=sCurrentISOtext & "_", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlWhole = 0, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
c.Activate
Exit Sub
notFound:
Application.InputBox "Could not find the range you wanted."
' >> You can put in whatever action you want here -- for example, <<
' >> if you're using this as a module, then "Exit Sub" or "Goto nextOne" <<
' >> could be used go to the next step in your process. <<

Resources