I have 2 TextBox controls where criteria 1 and criteria 2 are passed. The function opens an Excel file provided in the filepath (destination1) and in Sheet2 the vlookup must take col A, col B and return col C value to textbox3.
However the error I get is:
System.NullReferenceException was unhandled HResult=-2147467261 Message=Object reference not set to an instance of an object.
Is there a simple way to use vlookup for searching 2 criterias in VB.NET?
Public Sub lookValue()
Dim cit1 As String
Dim cit2 As String
Dim xlApp As Excel.Application
xlApp = New Excel.Application
Dim wb As Excel.Workbook = xlApp.Workbooks.Open(destination1)
Dim sht As Excel.Worksheet
Dim userange As Excel.Range
Dim lastrow As Long
Dim lastcolumn As Long
Dim startcell As Excel.Range
'Finding the dynamic table range in sheet lookup
sht = wb.Worksheets("Sheet2")
startcell = sht.Range("A1")
'Find Last Row and Column
lastrow = sht.Cells(sht.Rows.Count, startcell.Column).End(Excel.XlDirection.xlUp).Row
lastcolumn = sht.Cells(startcell.Row, sht.Columns.Count).End(Excel.XlDirection.xlToLeft).Column
'select range
userange = sht.Range(startcell, sht.Cells(lastrow, lastcolumn))
'Constraints from 2 textboxs given in userform
If TextBox1.Text <> "" And TextBox2.Text <> "" Then
cit1 = TextBox1.Text
cit2 = TextBox2.Text
'calling vlookup function by passing the lookup range from above, return value in col C if col A in excel sheet(lookup)
'has textbox 1.value & col B in excel sheet(lookup) has textbox2.value
TextBox3.Text = Two_Con_Vlookup(userange, 3, cit1, cit2)
'xlApp.WorksheetFunction.VLookup(raw, userange, 1, False))
End If
End Sub
Function Two_Con_Vlookup(Table_Range As Excel.Range, Return_Col As Long, Col1_Fnd As String, Col2_Fnd As String) As Object
Dim rCheck As Excel.Range, bFound As Boolean, lLoop As Long
Dim xlmath As Excel.WorksheetFunction
'On Error Resume Next
rCheck = Table_Range.Columns(1).Cells(1, 1)
With xlmath
For lLoop = 1 To .CountIf(Table_Range.Columns(1), Col1_Fnd)
rCheck = Table_Range.Columns(1).find(Col1_Fnd, rCheck, LookIn:=Excel.XlFindLookIn.xlFormulas, LookAt:=Excel.XlLookAt.xlWhole, SearchDirection:=Excel.XlSearchDirection.xlNext, SearcbOrder:=Excel.XlSearchOrder.xlByRows, MatchCase:=False)
If UCase(rCheck(1, 2)) = UCase(Col2_Fnd) Then
bFound = True
Exit For
End If
Next lLoop
End With
If bFound = True Then
Two_Con_Vlookup = rCheck(1, Return_Col)
Else
Two_Con_Vlookup = "Match Not Found"
End If
End Function
You could use LINQ to query on the table you need are using the vlookup in and a 2nd query on the vlookup table, then combine the join the two queries. Run a loop for each query result to output your excel file column.
Related
I am trying to add values from a specific range(column) into a listbox. However, the range has blank cells and duplicates that I am trying to get rid of. The following code works (no error msg) and does populate the listbox, but it does not get rid of the duplicates.
Can someone help?
Private Sub UserForm_Initialize()
Dim rang, rang1 As Range
Dim lstrow As Long
Dim list(), ListUniq() As Variant
Dim iRw As Integer
Dim wb As Workbook
Dim ws As Worksheet
Dim x As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets("Paramed Verification Grid")
Set rang = ws.Range("E3").CurrentRegion
lstrow = rang.Rows.Count + 1
Set rang1 = Range("E3:E" & lstrow)
'list = ws.Range("E3:E" & lstrow).SpecialCells(xlCellTypeConstants)
'Resize Array prior to loading data
ReDim list(WorksheetFunction.CountA(rang1))
'Loop through each cell in Range and store value in Array
x = 0
For Each cell In rang1
If cell <> "" Then
list(x) = cell.Value
x = x + 1
End If
Next cell
ListUniq = WorksheetFunction.Unique(list)
ListUniq = WorksheetFunction.Sort(ListUniq)
ProviderListBx.list = ListUniq
End Sub
I am attempting to populate columns D-J of table1, with the values in table2, columns B-H. The values should be based upon the value of column C in table1.
I have the code below, but I believe that is copying the tables as is and not doing a check of the value in column C.
Images:
Sub wps()
Dim rng As Range
Dim strTable As String
Dim strAddress As String
Dim i As Long
With Worksheets("Procedures")
For i = 1 To .ListObjects.Count
strTable = .ListObjects(i).Name
Set rng = .ListObjects(strTable).Range
strAddress = rng.Cells(2, 3).Address
rng.Copy Destination:=Worksheets("Base Data").Range(strAddress)
With Worksheets("Base Data")
.ListObjects(i).Name = "quals"
End With
Next i
End With
End Sub
It looks like a destination.value=source.value situation, using a single Match(). You could wrap this in a loop on your destWS.
Maybe something like (mock-up, untested):
For i = 2 to lastRowDest
dim sourceWS as worksheet
set sourceWS = sheets(1)
dim destWS as worksheet
set destWS = sheets(2)
destinationSearchTerm = destWS.Cells(i,"C").Value
dim sourceRow as long
sourceRow = Application.Match(destinationSearchTerm, sourceWS.Columns("A"), 0)
destWS.Range(destWS.Cells(i,"D"), destWS.Cells(i,"J") = sourceWS.Range(sourceWS.Cells(sourceRow,"B"),sourceWS.Cells(sourceRow,"H")
Next i
I have 2 sheets is the CriteriaSheet and DataSheet that need to filter, which use the data in CriteriaSheet to fill in the Criterial argument of AutoFilter for filter data in DataSheet.
DataSheet
CriteriaSheet
My problem is, I want to know which Criteria is cannot find in the DataSheet. How do I know if the "Ant"(Criteria) doesn't exist in the DataSheet?
Function Filter_Function()
Dim Data_sh As Worksheet
Dim Filter_Criteria_Sh As Worksheet
Dim Output_sh As Worksheet
Set Data_sh = ThisWorkbook.Sheets("DataSheet")
Set Filter_Criteria_Sh = ThisWorkbook.Sheets("CriteriaSheet")
Set Output_sh = ThisWorkbook.Sheets("Output")
Output_sh.UsedRange.Clear
Data_sh.AutoFilterMode = False
Dim Emp_list() As String
Dim n, i As Integer
n = Application.WorksheetFunction.CountA(Filter_Criteria_Sh.Range("A:A")) - 2
ReDim Emp_list(n) As String
Dim R As String
For i = 0 To n
Emp_list(i) = Filter_Criteria_Sh.Range("A" & i + 2)
Next i
With Range("A1")
''get range before filter
Dim rngBefore As Range
Set rngBefore = Range(.Offset(1, 0), .Offset(1, 0).End(xlDown))
''filter
Data_sh.UsedRange.AutoFilter 2, Emp_list(), xlFilterValues
''get range after filter
On Error Resume Next
Dim rngAfter As Range
Set rngAfter = rngBefore.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
''check whether any cells matching criteria were found
If rngAfter Is Nothing Then
MsgBox "No found " & Emp_list()
'Exit Function
Else
Data_sh.UsedRange.Copy Output_sh.Range("A1")
End If
End With
Data_sh.AutoFilterMode = False
End Function
Could you please suggest? Thanks
Hello VBA Developers,
I am having a hard time solving a multi-wildcard filter for criteria(s) listed in an array. The code stops at "vTst = Doc_ID_Arr(i)", stating vTst = Empty. However, checking Doc_ID_Arr is not empty if you check the debugger.
Sub doc_id()
'Segment 1 ----
'Get the worksheet called "LOB Docs"
Dim sh_1 As Worksheet
Set sh_1 = ThisWorkbook.Worksheets("LOB Docs")
' Declare an array to hold all LOB Doc ID numbers
Dim Doc_ID_Arr As Variant
Dim Doc_ID_Value As String
Dim j As Long
Dim i As Long
With sh_1
lastrow_Header_Config = sh_1.Cells(Rows.count, "A").End(xlUp).Row
' Read LOB DOC ID's from Column Cell A2 to last value in Column A
ReDim Doc_ID_Arr(Application.WorksheetFunction.CountA(sh_1.Range("A2:A" & lastrow_Header_Config)) - 1) As Variant
j = 0
For i = 2 To lastrow_Header_Config
Doc_ID_Value = sh_1.Range("A" & i).Value
If Doc_ID_Value <> "" Then
Doc_ID_Arr(j) = "*" & Doc_ID_Value & "*"
j = j + 1
End If
Next
End With
' ' Debug.Print "Doc_ID_Value"
' For i = LBound(Doc_ID_Arr) To UBound(Doc_ID_Arr)
' Debug.Print Doc_ID_Arr(i)
' Next i
'Segment 2 ----
Dim sh_2 As Worksheet 'Data Sheet
Dim sh_3 As Worksheet 'Output Sheet
Set sh_2 = ThisWorkbook.Worksheets("GDL db") 'Data Sheet
Set sh_3 = ThisWorkbook.Worksheets("Seed Template Output")
Dim Dic As Object
Dim eleData As Variant
Dim eleCrit As Variant
Dim ArrData As Variant
Dim vTst As Variant
Set Dic = CreateObject("Scripting.Dictionary")
Dim x As Long
For x = LBound(Doc_ID_Arr) To UBound(Doc_ID_Arr)
vTst = Doc_ID_Arr(i)
Next x
With sh_2
.AutoFilterMode = False
ArrData = .Range("A1:A" & .Cells(.Rows.count, "A").End(xlUp).Row)
For Each eleCrit In vTst
For Each eleData In ArrData
If eleData Like eleCrit Then _
Dic(eleData) = vbNullString
Next
Next
.Columns("A:A").AutoFilter Field:=1, Criteria1:=Dic.Keys, Operator:=xlFilterValues
sh_2.UsedRange.Copy sh_3.Range("A1")
End With
End Sub
I am trying to filter sh_2, Column A for each value(individual) or all values(en masse) that is placed in the Doc_ID_Arr created in Segment 1. The target is to place each filter output for each ID onto sh_3, without overwriting previous placed values/rows.
Using your previously-posted sample workbook this works for me:
Sub document_link_extract()
'Define data source
Dim GDL_Data As Worksheet 'Datasheet holding Docs links
Dim LOB_Doc As Worksheet 'Docs to filter for
Dim Doc_Output_sh As Worksheet 'Seed Template - curated document list
Dim Doc_ID_List() As String, v, rngIds As Range
Dim arrVals, arrSearch, dict, rwV As Long, rwS As Long, srch
Set GDL_Data = ThisWorkbook.Sheets("Sheet2") 'DataSheet
Set LOB_Doc = ThisWorkbook.Sheets("Sheet1") 'Filter Criteria Sheet
Set Output_sht = ThisWorkbook.Sheets("Sheet3") 'Output for' Look 1/2 - URL Check & PDF Extract
Output_sht.UsedRange.Clear
'get array of search terms
With LOB_Doc
arrSearch = .Range(.Range("A2"), .Cells(.Rows.Count, 1).End(xlUp)).Value
End With
'get array of data column values
With GDL_Data
arrVals = .Range(.Range("A2"), .Cells(.Rows.Count, 1).End(xlUp)).Value
End With
Set dict = CreateObject("scripting.dictionary")
'loop over each search term
For rwS = 1 To UBound(arrSearch, 1)
srch = "*" & arrSearch(rwS, 1) & "*" '<< search term with wildcards
'loop over each value
For rwV = 1 To UBound(arrVals, 1)
v = arrVals(rwV, 1)
'if value matches search term then add to dictionary
If v Like srch Then dict(v) = True
Next rwV
Next rwS
GDL_Data.AutoFilterMode = False 'if there is any filter, remove it
'filter using the dictionary keys array
GDL_Data.UsedRange.AutoFilter 1, dict.keys, xlFilterValues
GDL_Data.UsedRange.Copy Output_sht.Range("A1")
GDL_Data.AutoFilterMode = False
End Sub
I need help in excel vba code for vlookup with 2 values provided from textbox 1 & textbox 2.
I have a worksheet in Thisworkbook called lookup (dynamic table)Image Sheet with lookup data
I have an userform with 3 textboxs where user will provide textbox 1 & textbox2 values if found in lookup columnc then textbox3 must return the vlookup value from col c from above sheet
Image of Userform
he lookup table rows are dynamic but columns are fixed so I have written the following code to get the range, textbox1 & textbox2 values then passing it to a function to get the value in textbox 3
But the code is not working nor I understand how to pass 2 conditions from textbox to vlookup & return value in 3rd box
Code
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim sht As Worksheet
Dim userange As Range
Dim lastrow As Long
Dim lastcolumn As Long
Dim startcell As Range
'Finding the dynamic table range in sheet lookup
Set sht = ThisWorkbook.Worksheets("lookup")
Set startcell = Range("A1")
'Find Last Row and Column
lastrow = sht.Cells(sht.Rows.Count, startcell.Column).End(xlUp).Row
lastcolumn = sht.Cells(startcell.Row, sht.Columns.Count).End(xlToLeft).Column
'select range
userange = sht.Range(startcell, sht.Cells(lastrow, lastcolumn)).Select
'Constraints from 2 textboxs given in userform
Dim cit1 As String
cit1 = TextBox1.Value 'textbox1
Dim cit2 As String
cit2 = TextBox2.Value 'textbox2
'calling vlookup function by passing the lookup range from above, return value in col D if col B in excel sheet(lookup) has textbox 1.value & col C in excel sheet(lookup) has textbox2.value
Two_Con_Vlookup(userange,D,cit1,cit2)
End Sub
Function Two_Con_Vlookup(Table_Range As Range, Return_Col As Long, Col1_Fnd, Col2_Fnd)
Dim rCheck As Range, bFound As Boolean, lLoop As Long
On Error Resume Next
Set rCheck = Table_Range.Columns(1).Cells(1, 1)
With WorksheetFunction
For lLoop = 1 To .CountIf(Table_Range.Columns(1), Col1_Fnd)
Set rCheck = Table_Range.Columns(1).find(Col1_Fnd, rCheck, xlValues, xlWhole, xlNext, xlRows, False)
If UCase(rCheck(1, 2)) = UCase(Col2_Fnd) Then
bFound = True
Exit For
End If
Next lLoop
End With
If bFound = True Then
Two_Con_Vlookup = rCheck(1, Return_Col)
'textbox3 must return with col D
TextBox3 = Two_Con_Vlookup.Value
Else
Two_Con_Vlookup = "#N/A"
TextBox3 = Two_Con_Vlookup.Value
End If
End Function
This might not be the best solution, but it will give you the result you are seeking for.
Create a helper column in your 'lookup' sheet concatenating column A and column B.
Then lookup with the concatenation of Textbox1 and Textbox2.