I want to consolidate two sheets. In Tabelle 3 is already some data. Therefore, I defined the Next Free Row (NFR) and want my data from Tabelle 5 added to the next free row in Tabelle 3. Therefore, I wrote the following VLookup function.
Sub ConsolidateData()
Dim lastrow As Long
Dim NFR As Long
lastrow = Tabelle5.Range("A" & Rows.Count).End(xlUp).Row
NFR = Tabelle3.Range("A" & Rows.Count).End(xlUp).Offset(-3).Row
Set myrange = Tabelle5.UsedRange
For i = 4 To lastrow
Tabelle3.Cells(NFR + i, 1) = Application.WorksheetFunction.VLookup(Tabelle5.Cells(i, 1), myrange, 1, False)
Tabelle3.Cells(NFR + i, 2) = Application.WorksheetFunction.VLookup(Tabelle5.Cells(i, 1), myrange, 2, False)
Next i
End Sub
Even though, I'm already using this code in a different workbook, where it works smooth, it doesn't work here. Instead Run-time error '1004' occurs for this line:
Tabelle3.Cells(NFR + i, 1) = Application.WorksheetFunction.VLookup(Tabelle5.Cells(i, 1), myrange, 1, False)
Does anyone see the mistake or can tell me what I've coded wrong?
It seems that Vlookup cannot find value you are looking for and therefore throws an error. Application.WorksheetFunction.VLookup will return error '1004' if value cannot be found. Please consider following test:
Put in cell A2 value of 15.
Run below macros
macro 1:
Sub test1()
check = Application.WorksheetFunction.VLookup(15, Range("A1:A5"), 1, False)
Debug.Print check
End Sub
macro 2:
Sub test2()
check = Application.WorksheetFunction.VLookup(1, Range("A1:A5"), 1, False)
Debug.Print check
End Sub
As you can see second one throws an error. To overcome that issue you should change WorksheetFunction.VLoookup to Application.VLookup and implement error checking:
Sub test2()
If IsError(Application.VLookup(1, Range("A1:A5"), 1, False)) = False Then
check = Application.VLookup(1, Range("A1:A5"), 1, False)
End If
Debug.Print check
End Sub
Please look here as well: How to error handle 1004 Error with WorksheetFunction.VLookup?
Related
I am new to vba and i have encountered into some problems.
I want to look up something from another worksheet and copy the match value to the other cell
VBA said it was the last code having problem.
Private Sub ReferenceOk_Click()
Dim nextRefRec As Integer
Dim i As Integer
Dim ListNo As Integer
ListNo = ListBoxBook.ListIndex
If ListNo < 0 Then
MsgBox "Please select any book"
Exit Sub
End If
Sheets("Rental History").Activate
nextRefRec = Cells(Rows.Count, 2).End(xlUp).Row + 1
For i = 0 To 1
Cells(nextRefRec, i + 3).Value = ListBoxBook.List(ListNo, i)
Next i
Cells(nextRefRec, 3).NumberFormat = "0000"
Cells(nextRefRec, 2).NumberFormat = "00000"
Cells(nextRefRec, 2).Value = TxtMemberNo.Value
Cells(nextRefRec, 5).Value = Date
Cells(nextRefRec, 6).Value = Date + TxtRentalDays.Value
Cells(nextRefRec, 7).Value = Application.WorksheetFunction.VLookup(Worksheets("Rental History").Cells(nextRefRec, 4), Worksheets("Book List").Cells("B4:C24"), 6, False)
End Sub
Your VLOOKUP formula:
VLookup(Worksheets("Rental History").Cells(nextRefRec, 4), Worksheets("Book List").Cells("B4:C24"), 6, False)
seems invalid.
The range Worksheets("Book List").Cells("B4:C24") contains 2 columns, but your third argument is 6. In other words, you are attempting to get the 6th column of a 2-column range (which obviously doesn't exist). So at the moment it's probably returning a #REF error.
Further info on VLOOKUP if needed: https://support.office.com/en-us/article/vlookup-function-0bbc8083-26fe-4963-8ab8-93a18ad188a1
Fix your VLOOKUP formula so that you're passing a column that at least exists within the range you pass as the second argument.
Also, I recommend declaring these variables as type Long (to prevent type overflow errors):
Dim nextRefRec As Integer
Dim i As Integer
Dim ListNo As Integer
and changing this line:
Cells(nextRefRec, 7).Value = Application.WorksheetFunction.VLookup(Worksheets("Rental History").Cells(nextRefRec, 4), Worksheets("Book List").Cells("B4:C24"), 6, False)
to this (except also fix your VLOOKUP arguments as mentioned above):
Cells(nextRefRec, 7).Value = Application.VLookup(Worksheets("Rental History").Cells(nextRefRec, 4), Worksheets("Book List").Cells("B4:C24"), 6, False)
so that if VLOOKUP returns #N/A or some other error, the error value can be written to the cell instead of interrupting your macro.
Your code implicitly refers to whatever sheet happens to be active whilst the code is running. Try to refer to the parent workbook and worksheet (in case the sheet that's active isn't the one that you think it is).
Sub test()
Application.DisplayAlerts = False
Application.ScreenUpdating = False 'keeping the screen clean
Sheets("Data").Select
'Here is where the error is triggered.
With ThisWorkbook.Worksheets("TestSheet")
'.Range("A2:A" & Lr).Formula = "=CusVlookup(Z2,Data'!A:B,2)" <- this doesnt work either
.Range("A2:A" & Lr) = "=CusVlookup(Z2,Data'!A:B,2)"
End With
End Sub
Function CusVlookup(lookupval, LookupRange As Range, indexcol As Long)
Dim x As Range
Dim Result As String
Result = ""
For Each x In LookupRange
If x = lookupval Then
Result = Result & "," & x.Offset(0, indexcol - 1)
End If
Next x
CusVlookup = Result
End Function
I've tried using the regular Vlookup and works just fine but if I try to use this custom function it triggers the error. By the way I need to get the multiple matches "vlookups" into one cell separated by comma.(I added the goal just in case you know a better/faster way to do the same.)
whats wrong with the code?
Error 1004 - Application-defined or object-defined error
I want to setup a template that finds data based on pasted data in another worksheet.
Private Sub GoNoGo()
Dim i As Integer
Dim OffInt As Integer
Dim Neg As Integer
Neg = -30
Dim Ret As String
Dim I3 As Cell
Dim FindValue As String
Worksheets("BF59520").Activate
Range("AE3").Activate
i = 3
OffInt = 0
Do Until ActiveCell.Offset(0, Neg).Value = ""
If ActiveCell.Offset(0, -1).Interior.Color = RGB(255, 235, 160) Then
ActiveCell.Offset(1, 0).Activate
i = i + 1
Else
ActiveCell.Value = Application.WorksheetFunction.VLookup(ActiveCell.Offset(0, -18), Worksheets("Go No Go").Range("B2:O180"), 4, False)
ActiveCell.Offset(1, 0).Activate
i = i + 1
End If
OffInt = OffInt + 1
Loop
End Sub
When the loop gets to the VLOOKUP Line the code returns an error of Run-Time error '1004':
Unable to get the VLOOKUP property of the worksheetFunction class.
Generally, when you get that error on a Worksheet Function it means the function itself has returned an error. Make sure you're passing it the right values. If you can't guarantee that you'll get a correct value from the function then you can try using On Error like so
On Error Resume Next
Application.WorksheetFunction.VLookup(ActiveCell.Offset(0, -18), Worksheets("Go No Go").Range("B2:O180"), 4, False)
On Error GoTo 0
or you can capture the error in an evaluate statement like so
ActiveCell.Value = Evaluate("=IFERROR(VLOOKUP(" & ActiveCell.Offset(0,-18) & ", 'Go No Go'!B2:O180, 4, FALSE),0)")
The first will result in a no change in the ActiveCell when the vlookup fails, the second allows you to set a default value as the second argument of the 'IFERROR' function.
Hope this helps!
Im trying to highlight range of cells when a date is present in the list of holidays. But on running the below code, the Run time error 1004 is displayed. I have even tried handling it in error handler; but it is not working. Can somebody please help me why this error is occuring and resolve the same?
Sub highlight_cells()
Dim myrange As Range
On Error GoTo myerr:
For i = 1 To 10
Set myrange = Range(Cells(1, i), Cells(10, i))
temp = Application.WorksheetFunction.VLookup(Range(Cells(1, i)), [holidays], 2, False)
If (Application.WorksheetFunction.IsNA(temp)) Then
myrange.Interior.Color = 3
End If
Next i
myerr:
If Err.Number = 1004 Then
MsgBox "vlookup error"
End If
End Sub
Range(Cells(1, i)) isn't a valid range reference
maybe you wanted to reference Cells(1, i)
furthermore you can exploit the Application VLookup() method that wraps the possible error in the returned variant variable that you can check with IsError() function like follows:
Dim temp As Variant
For i = 1 To 10
Set myrange = Range(Cells(1, i), Cells(10, i))
temp = Application.VLookup(Cells(1, i), [holidays], 2, False)
If Not IsError(temp) Then Cells(1, i).Interior.Color = 3
Next i
Here is a conditional formatting method, without using VBA.
Select your range > Conditional Formating > New Rule > Use a formula ...
Enter this formula
=VLOOKUP($A2,$J$2:$K$6,1,FALSE)
Take care of the "$" in the formula. This should highlight all cells that were found in the holidays list.
Your code is okay , It worked in Excel 2010 , Your problem is with VBA Error handling method.
Go to Tools --> Options -->General --> Error Trapping
And check "Break on unhanded Errors"
sorry all these times I was referring to column 2 in vlookup. That was causing the problem. The list of holiday is a single column list. Hence vlookup was throwing error. ANd one more thing the named ranges work as I have entered and even the actual range also gives the same result.
Sub highlight_cells()
Dim myrange As Range
For i = 1 To 10
Set myrange = Range(Cells(1, i), Cells(10, i))
MsgBox Cells(1, i)
temp = Application.VLookup(Cells(1, i), [holidays], 1, False)
If Not IsError(temp) Then
myrange.Interior.ColorIndex = 3
End If
Next i
End Sub
I have an issue. I am trying to copy all unique values (numerical and alphanumerical) from a dynamic sheet to another. I found a great script on a forum, which works quickly and have adapted this. The issue is that it seems to filter out all numerical values and for the life of me I cannot see why!?! Can you help?
Sub GetUniqueItems()
Dim vData As Variant, n&, lLastRow&, sMsg$
lLastRow = Worksheets(Worksheets("Summary").Range("A1").Value)._
Cells(Rows.Count, "H").End(xlUp).Row
If lLastRow = 1 Then Exit Sub '//no data
vData = Worksheets(Worksheets("Summary").Range("A1").Value)._
Range("H2:H" & lLastRow)
Dim oColl As New Collection
On Error Resume Next
For n = LBound(vData) To UBound(vData)
oColl.Add vData(n, 1), vData(n, 1)
Next 'n
For n = 1 To oColl.Count
sMsg = oColl(n)
Sheets("Summary").Cells(n + 3, 1).Value = Mid$(sMsg, 1)
Next 'n
End Sub
The key for a Collection item needs to be a string. So change this line:
oColl.Add vData(n, 1), vData(n, 1)
to this:
oColl.Add vData(n, 1), CStr(vData(n, 1))
Also, although you need the On Error Resume Next so the code will skip over any attempts to add duplicates to the collection, you should only use it for that one line. Otherwise you risk masking other errors in your code. (The reason your code didn't have a runtime error was because the On Error Resume Next, in addition to doing it's job of bypassing duplicates, was also skipping over any Adds with numeric Keys.
For that reason, I moved the line to just before the oColl.Add and added On Error Goto 0 just after:
Here's the full routine:
Sub GetUniqueItems()
Dim vData As Variant, n&, lLastRow&, sMsg$
Dim oColl As Collection
lLastRow = Worksheets(Worksheets("Summary").Range("A1").Value).Cells(Rows.Count, "H").End(xlUp).Row
If lLastRow = 1 Then Exit Sub
vData = Worksheets(Worksheets("Summary").Range("A1").Value).Range("H2:H" & lLastRow)
Set oColl = New Collection
For n = LBound(vData) To UBound(vData)
On Error Resume Next
oColl.Add vData(n, 1), CStr(vData(n, 1))
On Error GoTo 0
Next n
For n = 1 To oColl.Count
sMsg = oColl(n)
Sheets("Summary").Cells(n + 3, 1).Value = Mid$(sMsg, 1)
Next n
End Sub
One last thing: you want to avoid statements like Dim oColl As New Collection, and instead declare and set it in two steps as I did. For the reason see the Chip Pearson page and scroll down to "Don't Use Auto-Instancing Object Variables."
I am showing the code below as it may be of interest to the OP, or others, and is an efficient way to obtain a unique list from a column of data.
In Excel 2007 or above we can copy the column and make use of the Remove Duplicates feature to obtain our unique list.
Sub CreateUniqueList()
Dim lLastRow As Long
Dim wsSum As Worksheet
Dim rng As Range
Set wsSum = Worksheets("Summary")
lLastRow = wsSum.Cells(Rows.Count, "H").End(xlUp).Row
If lLastRow = 1 Then Exit Sub
wsSum.Range("H2:H" & lLastRow).Copy wsSum.Cells(4, 1)
wsSum.Range(wsSum.Cells(4, 1), wsSum.Cells(4 + lLastRow - 2, 1)). _
RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
The only slight disadvantage is that we first have to copy the entire column, but this is minor in comparison to the performance increase for a large set of data.