Excel VBA Run Time Error '424' object required - vba

I am totally new in VBA and coding in general, am trying to get data from cells from the same workbook (get framework path ...) and then to start application (QTP) and run tests.
I am getting this error when trying to get values entered in excel cells:
Run Time Error '424' object required
I believe I am missing some basic rules but I appreciate your help. Please see below the part of code in question:
Option Explicit
Private Sub RunTest_Click()
Dim envFrmwrkPath As Range
Dim ApplicationName As Range
Dim TestIterationName As Range
'Dim wb As Workbook
'Dim Batch1 As Worksheets
Dim objEnvVarXML, objfso, app As Object
Dim i, Msgarea
Set envFrmwrkPath = ActiveSheet.Range("D6").Value ' error displayed here
Set ApplicationName = ActiveSheet.Range("D4").Value
Set TestIterationName = ActiveSheet.Range("D8").Value

The first code line, Option Explicit means (in simple terms) that all of your variables have to be explicitly declared by Dim statements. They can be any type, including object, integer, string, or even a variant.
This line: Dim envFrmwrkPath As Range is declaring the variable envFrmwrkPath of type Range. This means that you can only set it to a range.
This line: Set envFrmwrkPath = ActiveSheet.Range("D6").Value is attempting to set the Range type variable to a specific Value that is in cell D6. This could be a integer or a string for example (depends on what you have in that cell) but it's not a range.
I'm assuming you want the value stored in a variable. Try something like this:
Dim MyVariableName As Integer
MyVariableName = ActiveSheet.Range("D6").Value
This assumes you have a number (like 5) in cell D6. Now your variable will have the value.
For simplicity sake of learning, you can remove or comment out the Option Explicit line and VBA will try to determine the type of variables at run time.
Try this to get through this part of your code
Dim envFrmwrkPath As String
Dim ApplicationName As String
Dim TestIterationName As String

Simply remove the .value from your code.
Set envFrmwrkPath = ActiveSheet.Range("D6").Value
instead of this, use:
Set envFrmwrkPath = ActiveSheet.Range("D6")

You have two options,
-If you want the value:
Dim MyValue as Variant ' or string/date/long/...
MyValue = ThisWorkbook.Sheets(1).Range("A1").Value
-if you want the cell object:
Dim oCell as Range ' or object (but then you'll miss out on intellisense), and both can also contain more than one cell.
Set oCell = ThisWorkbook.Sheets(1).Range("A1")

Private Sub CommandButton1_Click()
Workbooks("Textfile_Receiving").Sheets("menu").Range("g1").Value = PROV.Text
Workbooks("Textfile_Receiving").Sheets("menu").Range("g2").Value = MUN.Text
Workbooks("Textfile_Receiving").Sheets("menu").Range("g3").Value = CAT.Text
Workbooks("Textfile_Receiving").Sheets("menu").Range("g4").Value = Label5.Caption
Me.Hide
Run "filename"
End Sub
Private Sub MUN_Change()
Dim r As Integer
r = 2
While Range("m" & CStr(r)).Value <> ""
If Range("m" & CStr(r)).Value = MUN.Text Then
Label5.Caption = Range("n" & CStr(r)).Value
End If
r = r + 1
Wend
End Sub
Private Sub PROV_Change()
If PROV.Text = "LAGUNA" Then
MUN.Text = ""
MUN.RowSource = "Menu!M26:M56"
ElseIf PROV.Text = "CAVITE" Then
MUN.Text = ""
MUN.RowSource = "Menu!M2:M25"
ElseIf PROV.Text = "QUEZON" Then
MUN.Text = ""
MUN.RowSource = "Menu!M57:M97"
End If
End Sub

Related

Pass array function into user defined function

I have a standard user defined function that concationates all the unique values. What I am trying to do is to perform this function on a range that satisfies a condition.
Function ConcatUniq(xRg As Range, xChar As String) As String
'updateby Extendoffice 20151228
Dim xCell As Range
Dim xDic As Object
Set xDic = CreateObject("Scripting.Dictionary")
For Each xCell In xRg
xDic(xCell.Value) = Empty
Next
ConcatUniq = Join$(xDic.Keys, xChar)
Set xDic = Nothing
End Function
Lets make an example:
If we have the following data:
A1:A5 = {1,2,2,4,1}
B1:B5 = {"group1", "group1","group1", "group2", "group2"}
C1 = "group1"
Now I want to find the unique values using the ConcatUniq function for all numbers that are in group1. Usually, if I want to perform another function for example the median I would do the following:
=MEDIAN(IF(B1:B5=C1,A1:A5))
Activate it using cntrl shift enter which gives 2 (create an array function from it).
For some reasons this does not work in combination with a user defined function.
=ConcatUniq(IF(B1:B5=C1,A1:A5)," ")
Desired result:
1 2
Does someone know how I could fix this problem?
You need to use ParamArray to accommodate array returned from Excel's array formula. As ParamArray should always be the last one, so your method signature will change.
This will work with =ConcatUniq(" ",IF(B1:B5=C1,A1:A5)) on CTRL + SHIFT + ENTER
Public Function ConcatUniq(xChar As String, ParamArray args())
Dim xDic As Object
Dim xVal
Set xDic = CreateObject("Scripting.Dictionary")
For Each xVal In args(0)
If Not Not xVal Then
xDic(xVal) = Empty
End If
Next
ConcatUniq = Join$(xDic.Keys, xChar)
End Function
Perhaps something like this:
Public Function ConcatUniq(ByVal rangeOrArray As Variant, ByVal xChar As String) As String
Dim generalArray As Variant
If IsArray(rangeOrArray) Then
'operate on it as if was an array
generalArray = rangeOrArray
Else
If TypeName(rangeOrArray) = "Range" Then
'operate on it as if was a Range
If rangeOrArray.Cells.Count > 1 Then
generalArray = rangeOrArray.Value
Else
generalArray = Array(rangeOrArray.Value)
End If
Else
'Try to process as if it was a derivative of a value of a single cell range.....
generalArray = Array(rangeOrArray)
End If
End If
Dim xDic As Object
Set xDic = CreateObject("Scripting.Dictionary")
Dim xCell As Variant
For Each xCell In generalArray
If xCell <> False Then xDic(xCell) = Empty ' EDIT - HACKY....
Next
ConcatUniq = Join$(xDic.Keys, xChar)
End Function
You can see that that whole block of if-elses can be factored out to be a separate function to transform worksheet input to a unified form for operating on values of a worksheet.
The easiest solution would probably be to introduce an additional function. This function would take care of the condition and would generate an array consisting only of data fulfilling the condition.
Try something like this:
function condition_check(data1() as integer, data2() as string, condition_value as string) as integer
number_of_elements = Ubound(data1)
j = 0
for i = 0 to number_of_elements
if data2(i) = condition_value then
condition_check(j) = data1(i)
j = j+1
end if
next i
end function

VBA: Function gives "Run time error '424': Object required" Error when called

I have two main functions, the first is search_bank. It searches through the Credits, Type, and store columns, cell by cell and figures out if we have a match or not.If there is a match, it returns True and as a side effect changes the color of the matched cell.
The second sub I'm using to test the first function.
The problem I'm having is that I'm getting a Run time error '424': Object required with no indication of where the issue is.
Here is the first function:
Function search_bank(Store As String, amount As Double, Amex As Boolean) As Boolean
Dim m_store As Range
Dim m_type As Range
Dim Credit_Amt_Col As Range
Set m_store = bank_sheet.Range("1:1").Find("M_STORE")
Set m_type = bank_sheet.Range("1:1").Find("M_TYPE")
Set Credit_Amt_Col = bank_sheet.Range("1:1").Find("Credit Amt")
search_bank = False
Dim i As Long
For i = 1 To 9000
If Not search_bank Then
Dim store_cell As Range
Dim type_cell As Range
Dim credit_cell As Range
Set store_cell = Worksheets(2).Cells(i, m_store.Column)
Set type_cell = Worksheets(2).Cells(i, m_type.Column)
Set credit_cell = Worksheets(2).Cells(i, Credit_Amt_Col.Column)
If InStr(UCase(store_cell.Value), UCase(Store)) > 0 And credit_cell.Value = amount Then
If store_cell.Interior.ColorIndex <> 46 Then
If Amex And InStr(UCase(type_cell.Value), UCase("amex deposit")) Then
store_cell.Interior.ColorIndex = 46
search_bank = True
End If
If Not Amex And InStr(UCase(type_cell.Value), UCase("Credit Card Deposit")) Then
store_cell.Interior.ColorIndex = 46
search_bank = True
End If
End If
End If
End If
Next i
End Function
and here is the tester:
Sub Tester()
Dim x As Boolean
x = search_bank("ctc", 38.4, True)
Debug.Print (x)
End Sub
I have tried using 'set' on the tester:
Sub Tester()
Dim x As Boolean
Set x = search_bank("ctc", 38.4, True)
Debug.Print (x)
End Sub
And even declaring the variable before passing them in the tester (I'm not very used to VBA but for a moment I believed it was just so ancient, it needed things to be declared before they're passed)
Sub Tester()
Dim x As Boolean
Dim store As String
Dim Amount As Double
Dim amex As Boolean
store = "ctc"
Amount = 38.4
amex = True
x = search_bank(store, Amount, amex)
Debug.Print (x)
End Sub
I would post this as a comment if I could, but I can't. So I know this won't directly solve it, but it will help in debugging. See below:
Function search_bank(Store As String, amount As Double, Amex As Boolean) As Boolean
Dim m_store As Range
Dim m_type As Range
Dim Credit_Amt_Col As Range
' It is always best to check the inverse of an object before setting
' setting an object variable to the target object. In this case
' I check to make sure each range can be found, and if not, I
' debug.print which variable cannot be set.
Set m_store = bank_sheet.Range("1:1").Find("M_STORE")
Set m_type = bank_sheet.Range("1:1").Find("M_TYPE")
Set Credit_Amt_Col = bank_sheet.Range("1:1").Find("Credit Amt")
If m_store is Nothing then Debug.Print "m_store is nothing"
If m_type is Nothing then Debug.Print "m_type is nothing"
If Credit_Amt_Col is Nothing then Debug.Print "Credit_Amt_Col is nothing."
search_bank = False
Dim i As Long
For i = 1 To 9000
If Not search_bank Then
Dim store_cell As Range
Dim type_cell As Range
Dim credit_cell As Range
' Use the inverse method above on these three items as well.
Set store_cell = Worksheets(2).Cells(i, m_store.Column)
Set type_cell = Worksheets(2).Cells(i, m_type.Column)
Set credit_cell = Worksheets(2).Cells(i, Credit_Amt_Col.Column)
If InStr(UCase(store_cell.Value), UCase(Store)) > 0 And credit_cell.Value = amount Then
If store_cell.Interior.ColorIndex <> 46 Then
If Amex And InStr(UCase(type_cell.Value), UCase("amex deposit")) Then
store_cell.Interior.ColorIndex = 46
search_bank = True
End If
If Not Amex And InStr(UCase(type_cell.Value), UCase("Credit Card Deposit")) Then
store_cell.Interior.ColorIndex = 46
search_bank = True
End If
End If
End If
End If
Next i
End Function
I posted a comment inline, but basically I added an inverse check for your first three objects (you would want to do this for your second set of objects as well). This is best practice, but in this case it will also (hopefully) help you pinpoint where the object cant be found.
There's lots of good commentary under your OP, and with #BrandonBarney's answer too, but here's my two cents:
Cent one: The biggest thing I see is you never declare blank_sheet yet try to use it while setting a range object. This is where your error is coming from. It's looking to do Range("1:1").Find("M_STORE"), but doesn't know what bank_sheet is.
Cent two: A quick way to have this pointed out to you is to always use Option Explicit at the top of your code. That ensures that any variable you use is explicitly declared. I.e.:
Option Explicit
Function search_bank(Store As String, amount As Double, Amex As Boolean) As Boolean
Dim m_store As Range
Dim m_type As Range
Dim Credit_Amt_Col As Range
''''' New code here: ''''''
Dim bank_sheet as Worksheet
Set bank_sheet = Worksheets("Bank Sheet") ' change to whatever the name is.
'''''''''''''''''''''''''''
Set m_store = bank_sheet.Range("1:1").Find("M_STORE")
Set m_type = bank_sheet.Range("1:1").Find("M_TYPE")
Set Credit_Amt_Col = bank_sheet.Range("1:1").Find("Credit Amt")
' etc. etc.
Option Explicit will also help if you ever accidentally have a typo. So if you ever did bank_sheeet.Range("A:A") it'll error out and ask you to declare bank_sheeet. Or, of course, you'll realize it's a typo and then just fix it.
Bonus cent: You can save a few lines by combining your Dims:
Dim m_store as Range, m_type as Range, Credit_Amt_Col as Range can all be on one line.
(Note: Doing Dim m_store, m_type, Credit_Amt_Col as Range will not set all three to Range type. It'll make m_store and m_type a Variant since it's not declared. Only Credit_Amt_Col would be a Range in that case. So you still have to explicitly state the type for each variable).

Type mismatch error in VBA when adding data to textbox

I have a TextBox and a ListBox with a list of various cities being populated from an Excel file
Now each city has one of two options: either within territory or outside. I want that option to be shown in textBox
I tried something like this :
Private Sub CommandButton1_Click()
TextBox2.Value = Application.VLookup(Me.ListBox1.Text,Sheets("Sheet1").Range("B:C"), 2, False)
End Sub
But am getting error stating that :
Run Time Error 2147352571 (80020005) . Could not set Value property. Type mismatch.
My excel file is something like this :
Let say your data are stored in Sheet1. You want to bind these data to ListBox1 on UserForm. I'd suggest to use custom function to load data instead of binding data via using RowSource property. In this case i'd suggest to use Dictionary to avoid duplicates.
See:
Private Sub UserForm_Initialize()
Dim d As Dictionary
Dim aKey As Variant
Set d = GetDistinctCitiesAndTerritories
For Each aKey In d.Keys
With Me.ListBox1
.AddItem ""
.Column(0, .ListCount - 1) = aKey
.Column(1, .ListCount - 1) = d.Item(aKey)
End With
Next
End Sub
'needs reference to Microsoft Scripting Runtime!
Function GetDistinctCitiesAndTerritories() As Dictionary
Dim wsh As Worksheet
Dim dict As Dictionary
Dim i As Integer
Set wsh = ThisWorkbook.Worksheets("Sheet1")
Set dict = New Dictionary
i = 2
Do While wsh.Range("A" & i) <> ""
If Not dict.Exists(wsh.Range("B" & i)) Then dict.Add wsh.Range("B" & i), wsh.Range("C" & i)
i = i + 1
Loop
Set GetDistinctCitiesAndTerritories = dict
End Function
After that, when user clicks on ListBox, city and territory are displayed in corresponding textboxes.
Private Sub ListBox1_Click()
Me.TextBoxCity = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)
Me.TextBoxTerritory = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
End Sub
Note: code was written straight from the head, so it can contains errors!
The problem is likely that you aren't checking to see to see if the call to Application.VLookup succeeded. Most values returned can be successfully cast to a String - with one important exception: If the VLookup returns an error, for example it doesn't find Me.ListBox1.Text - it can't cast the Variant returned directly.
This should demonstrate:
Private Sub ReturnsOfVLookup()
Dim works As Variant, doesnt As String
works = Application.VLookup("Something not found", _
Sheets("Sheet1").Range("B:C"), 2, False)
Debug.Print works
On Error Resume Next
doesnt = Application.VLookup("Something not found", _
Sheets("Sheet1").Range("B:C"), 2, False)
If Err.Number <> 0 Then
Debug.Print Err.Description
Else
Debug.Print doesnt 'We won't be going here... ;-)
End If
End Sub

Vlookup with prompts

I am currently trying to make a form in vba to request a pin from the user, and am trying to have it display the users corresponding initials, but my vlookup keeps not returning any values.
I have a worksheet titled 'userinfo'
Column A is pins, Column B is initials
I am trying to figure out a way for VBA to take the input from the prompt box, vlookup the data, and paste that resulting data into a cell.
EG
Sheet 1 = Maintenance
Press [Record Maintenance]
Box pops up prompting the users pin
User types pin
If pin is in the table for userinfo $A:$B, then copy column 2
Paste column 2 into Cell K7 on sheet 1 (maintenance)
To use VLOOKUP within VBA code it is necessary to set reference style to R1C1, then it should work.
In my opinion to use excel built-in functions like VLOOKUP will result in quicker code. On the other hand to search cells for a value in for-each loop is bad practise and if you have large amount of data it will take a lot of time.
Here a sample code.
It uses two sheets: UserInfo, Maintenance. The formula is set up based on template string and finally Evaluate() is called to get the result of it. HTH.
Public Sub test()
Dim pin
pin = VBA.InputBox("Enter PIN", "PIN")
If (pin = "") Then Exit Sub
Dim userInfoSheet As Worksheet
Set userInfoSheet = Worksheets("UserInfo")
Dim dataRange As Range
Set dataRange = userInfoSheet.Columns("a:b")
Dim initailsColumn As Byte
initailsColumn = dataRange.Columns(2).Column
Dim originalReferenceStyle
originalReferenceStyle = Application.ReferenceStyle
Application.ReferenceStyle = xlR1C1
Dim lookup As String
Const EXACT_MATCH As Integer = 0
lookup = "=VLOOKUP({PIN}, {DATA_RANGE}, {INITIALS_COLUMN}, {MATCH_TYPE})"
lookup = VBA.Replace(lookup, "{PIN}", pin)
lookup = VBA.Replace(lookup, "{DATA_RANGE}", dataRange.Worksheet.Name & "!" & dataRange.Address(ReferenceStyle:=xlR1C1))
lookup = VBA.Replace(lookup, "{INITIALS_COLUMN}", initailsColumn)
lookup = VBA.Replace(lookup, "{MATCH_TYPE}", EXACT_MATCH)
Dim result As Variant
result = Application.Evaluate(lookup)
Application.ReferenceStyle = originalReferenceStyle
If (Not VBA.IsError(result)) Then
Dim maintenanceSheet As Worksheet
Set maintenanceSheet = Worksheets("Maintenance")
maintenanceSheet.Range("k7").Value = result
Else
Dim parsedError As String
parsedError = ParseEvaluateError(result)
MsgBox "Error: " & parsedError, vbExclamation, "Error"
End If
End Sub
Private Function ParseEvaluateError(ByRef errorValue As Variant) As String
Dim errorNumber As Long
Dim errorMessage As String
errorNumber = VBA.CLng(errorValue)
Select Case errorNumber
Case 2000:
errorMessage = "#NULL!"
Case 2007:
errorMessage = "#DIV/0!"
Case 2015:
errorMessage = "#VALUE!"
Case 2023:
errorMessage = "#REF!"
Case 2029:
errorMessage = "#NAME?"
Case 2036:
errorMessage = "#NUM!"
Case 2042:
errorMessage = "#N/A"
Case Else
errorMessage = "Unknow"
End Select
ParseEvaluateError = errorMessage
End Function
Here is an alternative to Daniel's solution. There is nothing wrong with Daniel's but I wanted to show a solution without using the Vlookup function. By eliminating the Vlookup function you will not have to handle the different error messages that the function can return. This is strictly personal preference.
Option Explicit
Sub TEST()
Dim PIN As Variant
Dim WRKSHT_USERINFO As Excel.Worksheet
Dim WRKSHT_MAINTENANCE As Excel.Worksheet
Dim COLUMN_WITH_INITIALS As Long
Dim CELL_WITH_INITIALS_MATCHING_PIN As Range
Dim DESTINATION_CELL As Range
PIN = VBA.InputBox("Enter PIN", "PIN")
If PIN = vbNullString Then Exit Sub
Set WRKSHT_USERINFO = ThisWorkbook.Sheets("userinfo")
Set WRKSHT_MAINTENANCE = ThisWorkbook.Sheets("Maintenance")
Set DESTINATION_CELL = WRKSHT_MAINTENANCE.Range("K7")
COLUMN_WITH_INITIALS = 2 ''Column B
Set CELL_WITH_INITIALS_MATCHING_PIN = Get_Cell_With_Initials(WRKSHT_USERINFO, PIN, COLUMN_WITH_INITIALS)
If CELL_WITH_INITIALS_MATCHING_PIN Is Nothing Then
MsgBox "No Records Found For PIN: " & PIN
Exit Sub
Else
WRKSHT_MAINTENANCE.Range(DESTINATION_CELL.Address).Value = CELL_WITH_INITIALS_MATCHING_PIN.Value
End If
End Sub
Function Get_Cell_With_Initials(ByRef WRKSHT_USERINFO As Excel.Worksheet, ByVal PIN As Variant, ByVal COLUMN_WITH_INITIALS As Long) As Range
Dim SEARCH_OBJECT As Object
Dim ROW_WITH_VALUE As Long
Set SEARCH_OBJECT = Cells.Find(What:=PIN, After:=WRKSHT_USERINFO.Cells(1, 1), LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If SEARCH_OBJECT Is Nothing Then
Exit Function
Else
ROW_WITH_VALUE = SEARCH_OBJECT.Row
End If
Set Get_Cell_With_Initials = WRKSHT_USERINFO.Cells(ROW_WITH_VALUE, COLUMN_WITH_INITIALS)
End Function

How to get the last record id of a form?

I currently have a form in access.
What I want to do is get the value of the last record added.
For example, if i have 10 records, I want to get the value "10", because this is the id of the added last record. I am trying to run a query with the function last id inserted() but it is not working.
This the code I am using :
Dim lastID As Integer
Query = "select last_insert_id()"
lastID = Query
MsgBox (lastID)
What am I missing?
There is a function DMax that will grab the highest number.
Dim lastID As Integer
lastID = DMax("IDField","YourTable")
' or = DMax("IDField","YourTable","WhenField=Value")
MsgBox lastID
The other Domain functions are:
DAvg
DCount
DFirst
DLast
DLookup
DMin
DStDev
DStDevP
DSum
DVar
DVarP
Check with your friendly F1 key for more info
Following on from the last comments, here's a piece of code I used recently to turn the last ID value of a record set into variable for use in VBA. It's not great, however, because I still can't work out how to turn the record's ID field value directly into a variable. Instead I used the inelegant solution of copying the record set into an excel workbook, and then setting the variable value to the value of the cell I just copied into.
EDIT: Worked out how to turn the ID into a simple variable: new code at end
This is all run from a single client workbook:
Option Explicit
Public AftUpD As Long
Public BfrUpD As Long
Sub AssignLstRowAftUpD2()
Dim dbPP As DAO.Database
Dim ResTemp As DAO.Recordset
Dim z As Long
Dim SelectLast As String
SelectLast = "SELECT Max(Table1.ID) AS MaxOfID FROM Table1"
'Debug.Print SelectLast
Set dbPP = OpenDatabase("C:\filepath\Database11.mdb")
Set ResTemp = dbPP.OpenRecordset(SelectLast)
If ResTemp.EOF Then
GoTo EndLoop
End If
Worksheets("Diagnostics").Visible = True
Worksheets("Diagnostics").Range("C4").CopyFromRecordset ResTemp
z = Sheets("Diagnostics").Range("C4").Value
Sheets("Diagnostics").Visible = False
AftUpD = z
'Debug.Print AftUpD
EndLoop:
ResTemp.Close
dbPP.Close
Set dbPP = Nothing
Set ResTemp = Nothing
'Set SelectionLast = Nothing
'z = Nothing
End Sub
Then I used this value as a variable to make a new SQL query:
Sub Query()
'This query uses the highest ID value in a companion spreadsheet (the public
'variable BfrUpD), which is set in a sub I haven't posted here, to find out
'how many records have been added to the database since the last time the
'spreadsheet was updated, and then copies the new records into the workbook
'Be warned: If you run this query when BfrUpD is equal to or greater than AftUpD it
'will cause a crash. In the end user version of this, I use several If tests,
'comparing BfrUpD with other public variables, to make sure that this doesn't
'happen.
Dim WBout As Excel.Workbook, WSout As Excel.Worksheet
Dim dbPP1 As DAO.Database
Dim qryPP1 As DAO.Recordset
Dim ResTemp1 As DAO.Recordset
Dim TestValue As String
Dim strSQL2 As String
TestValue = BfrUpD
'Debug.Print TestValue
strSQL2 = "SELECT * FROM Table1 WHERE (((Table1.ID)>" & TestValue & "))"
'Debug.Print strSQL2
Set dbPP1 = OpenDatabase("C:\filepath\Database11.mdb")
Set qryPP1 = dbPP1.OpenRecordset(strSQL2)
Set WBout = Workbooks.Open("C:\filepath\h.xlsm")
Set WSout = WBout.Sheets("sheet1")
WSout.Range("A1").End(xlDown).Offset(1, 0).CopyFromRecordset qryPP1
qryPP1.Close
dbPP1.Close
WBout.Save
WBout.Close
MsgBox "Data copied. Thank you."
Set WBout = Nothing
Set WSout = Nothing
Set dbPP1 = Nothing
Set qryPP1 = Nothing
Set ResTemp1 = Nothing
End Sub
EDIT: Code for getting field value directly into variable
Dim dbPP As DAO.Database
Dim ResTemp As DAO.Recordset
Dim z As Long
Dim SelectLast As String
SelectLast = "SELECT Max(Table1.ID) AS MaxOfID FROM Table1"
'Debug.Print SelectLast
Set dbPP = OpenDatabase("C:\filepath\Database11.mdb")
Set ResTemp = dbPP.OpenRecordset(SelectLast)
z = ResTemp(0) 'specifying it's array location (I think) - there is only one
'item in this result, so it will always be (0)
AftUpD = z
'Debug.Print AftUpD
ResTemp.Close
dbPP.Close
Set dbPP = Nothing
Set ResTemp = Nothing
'Set SelectionLast = Nothing
'z = Nothing
End Sub
What you would do is set up and save a query that gets the value for you first. Call it MaxID
e.g
SELECT Max(ID) as result FROM Your_Table_Name
Then, in your VBA code, set your variable to that
eg.
Dim IDresult As Integer
IDresult = DLookup("[result]", "MaxID")
MsgBox(IDresult)