Simple single cell populate with Vlookup value - vba

I am fairly new to VBA, I couldn't really find answer specific to my simple request (most answers were a lot more complicated....). I would like Cell E2 to populate with the result of the vlookup. Is there a simple way to do this?
Thanks and sorry if I failed to find a suitable answer..
Sub vlookup_customerror()
Worksheets("customerror").Activate
On Error GoTo Errormsg
Hobbyquery = Application.WorksheetFunction.VLookup(Range("E1"),
ActiveSheet.Range("A2:B5"), 2, 0)
Cells("E2").Value = Hobbyquery
GoTo ending
Errormsg: GoTo ending
ending: End Sub

Please try This: You can add error handler code also
Sub custom_error()
Dim result As Integer
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets("customerror")
Name = sheet.Range("E1").Value
result = Application.VLookup(Name, sheet.Range("A2:B5"), 2, False)
sheet.Range("E2").Value = result
Debug.Print result
End Sub
If you have string data in Column B then change Dim result As String
EDIT : To cover the situation , if the lookup value is on other sheet as per
apprehension expressed by #MacroMarc. In that case please try This:
Sub custom_error_v2()
Dim result As Variant
On Error Resume Next
result = Application.WorksheetFunction.VLookup(Range("E1"), _
Worksheets("Sheet1").Range("A:C"), 2, False)
On Error GoTo 0
If IsEmpty(result) Then
MsgBox "Value not found!"
End If
Range("E2") = result
End Sub
Images of sample data are appended below.
Please make changes to sheet names as per your requirement.

Related

If range has specific comment, show msg in another cell

I have this code in VBA and require it to show 'Final Bottling' in another sheet. Below is the code
Ip = input worksheet
op1 = Checks worksheet
i = 1
Cell = Ip.Cells(9, i + 2)
If LCase(Left(Cell, 14)) = "final bottling" Then
'#Checks Final Bottling
Op1.Cells(8, 5) = "Final Bottling Run, Please Consume materials. If unsure, check with materials planner!"
Else
Op1.Cells(8, 5) = ""
End If 'Check
The message appears if all comments in the range C9:H9 have the comment 'Final bottling'. But if only one of the cells in that range has the comment it wont appear anymore.
Not sure what to do now, apologies if this sounds dumb and must be an easy fix
This will show the message if any of the cell in C9:H9 in Ip has "Final bottling"
Sub Test()
Dim i As Long
Dim checkCell As Range
Set checkCell = op1.Cells(8, 5)
For i = 3 To 8
Debug.Print LCase(Left$(Ip.Cells(9, i).Value, 14))
If LCase(Left$(Ip.Cells(9, i).Value, 14)) = "final bottling" Then
checkCell.Value = "Final Bottling Run, Please Consume materials. If unsure, check with materials planner!"
Exit Sub 'Check is complete, exit sub from here
End If
Next i
checkCell.Value = vbNullString 'code will only pass here if it fails all the check in the loop above.
End Sub
You may use Match function to check if the range contains the string and set message:
pos = 0
On Error Resume Next
pos = Application.WorksheetFunction.Match("final bottling", Ip.Range("C9:H9"), 0)
' if not match (case insensitive), then error occurs and pos remains 0; if match was successful, pos = 1+
Op1.Cells(8, 5) = IIf(pos = 0, "", "Final Bottling Run, Please Consume materials. If unsure, check with materials planner!")
On Error GoTo 0
Another way is to use formula like this in cell Opt!E8:
=IFERROR(IF(MATCH("final bottling",Ip!C9:H9,0)>0,"Final Bottling Run, Please Consume materials. If unsure, check with materials
planner!",""),"")
Or use Ip.Range("C9:H9").Find() function

VLookUp not working - Property could not be assigned

My problem is, that when using the VlookUp I do get the Error:
The VLookup-Property of the WorksheetFunction-Object could not be assigned
' LookUp missing Data
Dim lookupRange As Range
Set lookupRange = Sheets("Kundenlisten HLK 2018").Range("A1:Y10354")
' Fill in Companyname
Dim tmp As String
tmp = Values(0)
tmp = TrueTrim(tmp)
testing.Cells(8, counter) = Application.WorksheetFunction.VLookup(tmp, lookupWS.Range("A2:Y10354"), 2, False)
Values = None
counter = counter + 1
lookupWS is the Name of the Worksheet
As you can see the table I am trying to lookup is filled with values from A to Y. The first column is the key I am trying to look up, but then the error from above occurs. The tmp variable is a String with a unique ID to look up the missing values, while the "2" is supposed to be the company name in the second column of the Range.
I looked up on the docs, but the types and everything are fine, I even checked while debugging.
testing.Cells(8, counter) can't be the source of the problem aswell, since I am using it before like this
testing.Cells(28, counter) = Left(mail.ReceivedTime, 10)
and it works
It's difficult to know what the problem is without any data, but here's something to help you in the right direction.
It's better to use Find and Offset than
WorksheetFunction.Vlookup in VBA
Something like this gives you exactly the same result, but you have much more control:
Sub Test()
Dim valueFound As Range
Set valueFound = lookupWS.Range("A2:A10354").Find(What:="Something", lookat:=xlWhole) 'xlWhole is equivalent to FALSE in VLOOKUP
If valueFound Is Nothing Then
MsgBox "Nothing found"
Else
MsgBox valueFound.Offset(0, 1) 'offsetting by 1 is equivalent to using 2 in a VLOOKUP
End If
End Sub

Excel VBA: Type Mismatch explanation

I'm a newcomer to VBA so was hoping someone with more experience could please explain why I receive a
Type Mismatch error
against the following:
Private Sub cbbWeek_Change()
txtWeekEnding = Application.VLookup(cbbWeek.Value, Worksheets("Formulas").Range("Q1:R53"), 2, False)
End Sub
I'm not sure if it's relevant but;
Column Q contains numbers from 1 (in cell Q1) to 52 (in cell Q52)
Column R contains dates formatted to dd/mm/yyyy
To see whether VLookup returns an error or not - assign the returned value to a variable. Check if the variable is an error, and if it is not an error - assign it to txtWeekending:
Private Sub TestMe()
Dim checker As Variant
Dim txtWeekending As Variant
checker = Application.VLookup("vityata", Range("A1:C53"), 2, False)
If Not IsError(checker) Then
Debug.Print checker
txtWeekending = checker
Else
Debug.Print checker
End If
End Sub
This is an article from CPearson, concerning the same problem.

Simple cipher in VBA in Excel using a table for substitution

I want to write a simple cipher in Excel which would take a text from a cell, substitute each letter for a number from adjacent column and then put the output in another cell. Can't get VLOOKUP to work - it works as a formula, but somehow can't get it to work inside VBA code. Tried to do a simple procedure first that would do this for one character (adding a loop later would be easy), but it doesn't work. It compiles, but when I run it (press a button I assigned it to) I get "#N/A" in the result cell.
Sub Zakoduj()
Dim Literka As String
Dim Liczba As Variant
Dim ColumnToTake As Integer
ColumnToTake = 1 ' Liczby
On Error Resume Next
Err.Clear
Literka = Sheets("Sheet2").Range("B2").Value
Liczba = Application.VLookup(Literka, Sheets("Sheet1").Range("A5:B39"), ColumnToTake, False)
If Err.Number = 0 Then
Sheet2.Range("B6").Value = Liczba
Else
Sheet2.Range("B6").Value = Err.Number
End If
End Sub
The range contains number and characters as follows:
Kod Litera
16 A
73 B
12 C
40 D
70 E
etc. etc.
Couldn't find a tutorial that would explain how to do this...
Here is a modified version. Note that the values are in A1:B6 on sheet 1
Option Explicit
Sub Zakoduj()
Dim Literka As Integer
Dim Liczba As String
Dim ColumnToTake As Integer
ColumnToTake = 2 ' Liczby
Literka = Sheets("Sheet2").Range("B2").Value
Liczba = "Value not found" 'If value is not found
On Error Resume Next
Liczba = Application.WorksheetFunction.VLookup(Literka, Sheets("Sheet1").Range("A1:B6"), ColumnToTake, False)
On Error GoTo 0 'Always reset error handling after On Error Resume Next
Sheet2.Range("B6").Value = Liczba
End Sub

Skip iteration of loop if certain value exists

I have the following code below that iterates through rows of a specific range and if a value is present (code not seen), creates copies of the entire pages. My concern is at the bottom of the code in the iteration of r1. It originally only had one conditional statement...
If BiDiRowValid(r1)
and I wanted to add a second conditional statement, which I did...
and Range("MAIN_BIDI_PINMC") <> "No BiDi"
but when I run the code and the MAIN_BIDI_PINMC range = "No BiDi", it errors out and doesn't get past that line. FYI: IsBiDiRowValid() is a function that checks to see that the specific r1 is not empty, and then continues. Right after that subroutine finishes and exits, my code errors with a "Type Mismatch error". I also added the ElseIf line at the bottom, I have not gotten to that code because the top errors out, but I just want to make sure I am writing this iteration correctly, and if anything else needs to be done. Basically, if "NoBiDi" is found in the range, I want it to skip all of this code and go to the next r1... which is what I think I have written... Thanks in advance!
Private Sub start_new()
Dim MC_List As Range
Dim r1 As Range
Dim biDiPinName As Range
Dim Pin As String
Dim mc As String
Dim mType As String
Dim tabName As String
Dim rowNumber As Integer
Dim pinmcSplit() As String
Dim NoBidi As String
On Error GoTo start_biDi_tr_new_Error
Set MC_List = Range("MAIN_PINMC_TABLE")
Set biDiPinName = Range("MAIN_PIN2_NAME")
For Each r1 In MC_List.Rows
If IsBiDiRowValid(r1) And WorksheetFunction.CountIf(Worksheets("MAIN").Range("MAIN_BIDI_PINMC", "No Bidi") = 0 Then
tabName = r1.Cells(1, 8)
pinmcSplit = Split(tabName, "_")
Pin = pinmcSplit(0)
mc = pinmcSplit(1)
mType = r1.Cells(1, 3)
ElseIf WorksheetFunction.CountIf(Worksheets("MAIN").Range("MAIN_BIDI_PINMC"), "No Bidi") = 1 Then
End If
Next
You are getting that error because Range("MAIN_BIDI_PINMC") is not a single cell. To check for a value in multiple cells you can use Application.Worksheetfunction.Countif
EDIT
Post discussion in chat, the user wanted to loop through each cell.
Dim aCell As Range
For Each r1 In MC_List.Rows
If IsBiDiRowValid(r1) Then
For Each aCell In Worksheets("MAIN").Range("MAIN_BIDI_PINMC")
If aCell.Value <> "No Bidi" Then
tabName = r1.Cells(1, 8)
pinmcSplit = Split(tabName, "_")
Pin = pinmcSplit(0)
mc = pinmcSplit(1)
mType = r1.Cells(1, 3)
End If
Next
ElseIf aCell.Value = "No Bidi" Then
'~~> Do Something
End If
Next