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.
Related
Hi guys i need some help on VBA.
I have range of numbers in sheet 1 from cells A6:O29. Next I have specific numbers selected in Sheet 3 in Column "B".
[![enter image description here][1]][1]
[![enter image description here][2]][2]
I want to loop throw each value in Sheet 3 Column B and find that specific value in Sheet 1 range A6:O29
Next it should paste Entire Row from Sheet 1 starting From Column (Q:CF) in Sheet 3 Starting from Column C onwards
I have coded it but its not working.
Private Sub CommandButton1_Click()
Dim main As Worksheet
Dim outcome As Worksheet
'main sheet contains Range to search number in
Set main = ThisWorkbook.Sheets("Sheet1")
'outcome sheet has specific values in Column B
Set outcome = ThisWorkbook.Sheets("Sheet3")
'column B values are considrered as doubles
Dim valuesfind As Double
'range where values are to be found
Dim myrange As Range
Set myrange = Worksheets("Sheet1").Range("A6:O29")
'no of times to loop code based on values in outcomesheet
locations = Worksheets("Sheet3").Cells(Rows.Count, 2).End(xlUp).Row
For i = 6 To locations
degrees = outcome.Range("B" & i).Value
For b = 6 To Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
If main.Range("A6:O29" & b).Value = degrees Then
outecome.Range("C:BR" & i).Value = main.Range("Q:CF" & b).Value
Exit For
End If
Next b
Next i
End Sub
[1]: https://i.stack.imgur.com/uBo66m.png
[2]: https://i.stack.imgur.com/D0bRUm.png
Please remember to declare all variables, add Option Explicit at the top of your module to help you enforce it.
Try the code below:
Option Explicit
Private Sub CommandButton1_Click()
'main sheet contains Range to search number in
Dim main As Worksheet
Set main = ThisWorkbook.Sheets("Sheet1")
Const mainCopyRng As String = "Q?:CF?"
'outcome sheet has specific values in Column B
Dim outcome As Worksheet
Set outcome = ThisWorkbook.Sheets("Sheet3")
Const outcomePasteRng As String = "C?:BR?"
'range where values are to be found
Dim myrange As Range
Set myrange = main.Range("A6:O29")
'no of times to loop code based on values in outcomesheet
Dim outcomeLastRow As Long
outcomeLastRow = outcome.Cells(Rows.Count, 2).End(xlUp).Row
Dim i As Long
For i = 6 To outcomeLastRow
Dim Degrees As Double
Degrees = outcome.Cells(i, 2).Value
Dim searchRng As Range
Set searchRng = myrange.Find(Degrees, LookIn:=xlValues, LookAt:=xlWhole)
If Not searchRng Is Nothing Then
Dim searchRow As Long
searchRow = searchRng.Row
outcome.Range(Replace(outcomePasteRng, "?", i)).Value = main.Range(Replace(mainCopyRng, "?", searchRow)).Value
End If
Next i
End Sub
This should work.
Sub Test()
Dim main As Worksheet
Set main = ThisWorkbook.Sheets("Sheet1")
Dim myrange As Range
Set myrange = main.Range("A6:O29")
Dim outcome As Worksheet
Set outcome = ThisWorkbook.Sheets("Sheet3")
'Set reference to locations in sheet3.
Dim locations As Range
With outcome
Set locations = .Range(.Cells(1, 2), .Cells(Rows.Count, 2).End(xlUp))
End With
'Search for each location in Sheet1 and if found copy to Sheet3.
Dim location As Range
Dim FoundLocation As Range
For Each location In locations
Set FoundLocation = myrange.Find( _
What:=location, _
After:=myrange.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Not FoundLocation Is Nothing Then
main.Cells(FoundLocation.Row, 1).Resize(, 15).Copy _
Destination:=location.Offset(, 1)
End If
Next location
End Sub
I am working on a macro that loops over a the used range in one sheet (which is the last sheet in the workbook) in a certain column ("H"). The macro should then copy the value, only if it is not 0, and paste it in a sheet called "Overview" in the original row, offset by 3 (e.g. first row becomes 4th row) and in the column behind the last used column in row 5. (I hope that makes sense?). I already worked on some code but I did not manage to reference the last used column correctly and am honestly close to a breakdown.
can someone explain to me what I am doing wrong?
This is what I already have:
Dim Cell As Range, cRange As Range, lrw As Long
Dim wsDestination As Worksheet, wsSource As Worksheet
'set worksheets
With ThisWorkbook
Set wsSource = .Worksheets(Sheets.Count)
Set wsDestination = .Worksheets("Overview")
End With
LastRow1 = wsSource.Cells(Rows.Count, "H").End(xlUp).Row
LastColumn1 = wsDestination.Cells(5, "A").End(xlRight).Column
Set cRange = wsSource.Range(wsSource.Cells(1, 8), wsSource.Cells(LastRow1, 8))
For Each Cell In cRange.Cells
If Cell.Value > 0 Then wsDestination.Cells(Cell.Row, LastColumn1).offset(3, 1) = Cell.Value
Next Cell
End Sub```
The Subtle Differences in Ways of Finding the 'Last Column'
To successfully test the first procedure, in a new worksheet you have to:
write a value in cell A1,
write ="" in cell B1,
write a value in cell C1,
hide column C
and use a fill color in cell D1.
The result of the test will be shown in the Immediate window CTRL+G.
The third procedure is an example of how to use the second procedure, the function for calculating the column of the last non-blank cell in a row using the Find method.
The Code
Option Explicit
Sub LastColumnSuptileDifferences()
Dim wb As Workbook
Set wb = ThisWorkbook ' The workbook containing this code.
Dim ws As Worksheet
Set ws = wb.Worksheets("Sheet1")
' Cell Value Comment
' A1: 1 Value
' B1: ="" Formula
' C1 1 Value: Hidden Column
' D1: Fill Color
Debug.Print ws.Rows(1).Find("*", , xlFormulas, , , xlPrevious).Column ' 3
Debug.Print ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column ' 2
Debug.Print ws.Rows(1).Find("*", , xlValues, , , xlPrevious).Column ' 1
Debug.Print ws.Rows(1).CurrentRegion.Columns.Count ' 3
Debug.Print ws.Rows(1).SpecialCells(xlCellTypeLastCell).Column ' 4
Debug.Print ws.UsedRange.Rows(1).Columns.Count ' 4
End Sub
' This will find the last column even if columns are hidden
' unless you set 'excludeEmpties' to 'True'.
' If you set 'excludeEmpties' to 'True', the right-most cells in the row,
' possibly containing a formula that evaluates to "", will be skipped.
' Additionally only the visible cells will be included, i.e. hidden
' right-most columns, possibly containing data in cells of the row,
' will not be considered (mimicking 'End(xlToLeft)' or CRTL+Left).
Function getLastColumnInRow(RowNumber As Variant, _
Optional Sheet As Worksheet = Nothing, _
Optional excludeEmpties As Boolean = False)
If Sheet Is Nothing Then
Set Sheet = ActiveSheet
End If
Dim FormVal As XlFindLookIn
If excludeEmpties Then
FormVal = xlValues
Else
FormVal = xlFormulas
End If
Dim rng As Range
Set rng = Sheet.Rows(RowNumber).Find(What:="*", _
LookIn:=FormVal, _
SearchDirection:=xlPrevious)
If Not rng Is Nothing Then
getLastColumnInRow = rng.Column
Else
getLastColumnInRow = 0
End If
End Function
Sub testgetLastColumnInRow()
'...
LastColumn1 = getLastColumnInRow(5, wsDestination)
If LastColumn1 = 0 Then
MsgBox "No Data.", vbExclamation, "Empty Row"
Exit Sub ' or whatever
End If
' Continue with code.
Debug.Print LastColumn1
'...
End Sub
So you didn't quite get the last column right. Here's it back.
Dim Cell As Range, cRange As Range, lrw As Long
Dim wsDestination As Worksheet, wsSource As Worksheet
'set worksheets
With ThisWorkbook
Set wsSource = .Worksheets(Sheets.Count)
Set wsDestination = .Worksheets("Overview")
End With
LastRow1 = wsSource.Cells(Rows.Count, "H").End(xlUp).Row
LastColumn1 = wsDestination.Cells(5, columns.count).End(xltoleft).Column
Set cRange = wsSource.Range(wsSource.Cells(1, 8), wsSource.Cells(LastRow1, 8))
For Each Cell In cRange.Cells
If Cell.Value > 0 Then wsDestination.Cells(Cell.Row, LastColumn1).offset(3, 1) = Cell.Value
Next Cell
End Sub```
I need a help with a vlookup using vba as I was not able to find the solution on the web
The situation is I have three sheets
Sheet 1: Lookup value in cell B3 with a name
Sheet 1
Sheet 2: Lookup table with column name and surname
Sheet 2
Sheet 3: Result of the lookup value in cell B3 with surname
Sheet 3
You can refer to the images for better understanding
So the value in sheet 1 is my lookup value and the surname has to be printed in the sheet 3 and the table array is in sheet 2
The code which I tried is
Sub nameloopkup()
Dim name As String
Dim result As String
Dim myrange As Range
name = Worksheets("Sheet1").Range("B3").Value
myrange = Worksheets("Sheet2").Range("A:B").Value
result = Application.WorksheetFunction.VLookup(name, myrange, 2, False)
' the query does not run and i don't know how can i print the result in sheet 3
End sub
This might be quiet simple for many around here. But considering my amature level to VBA, I need some guidance regarding the same.
Any kind of help or suggestion is appreciated.
Actuall all you need to do is:
Sub nameloopkup()
Dim Name As String
Dim Result As String
Dim SearchIn As Variant 'variant to use it as array
Name = Worksheets("Sheet1").Range("B3").Value
SearchIn = Worksheets("Sheet2").Range("A:B").Value 'read data into array
On Error Resume Next 'next line errors if nothing was found
Result = Application.WorksheetFunction.VLookup(Name, SearchIn, 2, False)
On Error Goto 0
If Result <> vbNullString Then
Worksheets("Sheet3").Range("B3").Value = Result
Else
MsgBox "Nothing found"
End If
End Sub
Alternatively just write a formula:
Sub NameLookUpFormula()
Worksheets("Sheet3").Range("B3").Formula = "=VLOOKUP(Sheet1!B3,Sheet2!A:B,2,FALSE)"
End Sub
Here is what you could 2... There are 2 options, if you only need 1 entry of data, or if you need a whole array of data and picking each time what you need from it:
Option Explicit
Sub nameloopkup()
Dim C As Range, LastRow As Long, EmptyRow As Long, i As Long, arrData
Dim DictData As New Scripting.Dictionary 'You need to check Microsoft Scripting Runtime from references for this
Dim wsNames As Worksheet, wsTable As Worksheet, wsSurnames As Worksheet
'First thing, reference all your sheets
With ThisWorkbook
Set wsNames = .Sheets("Sheet1") 'change this as needed
Set wsTable = .Sheets("Sheet2")
Set wsSurnames = .Sheets("Sheet3")
End With
'Keep all the data in one dictionary:
With wsTable
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'last row on Sheet2
i = .Cells(1, .Columns.Count).End(xlToLeft).Column 'last column on Sheet2
arrData = .Range(.Cells(1, 1), .Cells(LastRow, i)).Value 'keep the data on the array
'This will throw an error if there are duplicates
For i = 2 To UBound(arrData)
DictData.Add arrData(i, 1), i 'keep tracking of every name's position ' also change for arrData(i, 2) if you only need the surname
Next i
End With
With wsNames
LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row 'last row on Sheet1
For Each C In .Range("B3:B" & LastRow)
EmptyRow = wsSurnames.Cells(wsSurnames.Rows.Count, 1).End(xlUp).Row
wsSurnames.Cells(EmptyRow, 2) = DictData(C.Value) 'if you used arrData(i, 2) instead i
wsSurnames.Cells(EmptyRow, 2) = arrData(DictData(C.Value), 2) 'If you used i
Next C
End With
End Sub
myrange = Worksheets("Sheet2").Range("A:B").Value
result = Application.WorksheetFunction.VLookup(name, myrange, 2, False)
Here is your error. The second argument of Vlookup is a Range, not a String. As a range is an object, you also need to Set it:
Set myrange = Worksheets("Sheet2").Range("A:B")
result = Application.WorksheetFunction.VLookup(name, myrange, 2, False)
My workbook has two sheets: one "Data" and one "Kiert". I solved to copy rows by specific attributes from "data" to "Kiert" with UserForm, but I added ti user form four textboxes (TextBox1, TextBox2 etc.) and I want to fill the database with constant values added in textbox with one command button in blank colums after pasted data.
I have additional textbox5, which indicates if the copy was succefull ("SIKERES"), this part works fine...
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim Drng As Range, c As Range
Dim i As Long
Dim lastRow As Long
Dim srcRange As Range, fillRange As Range
Set a = TextBox5
Set d = TextBox1
Set ws = Sheets("Data")
Set Drng = ws.Columns("A:A").SpecialCells(xlCellTypeConstants, 23)
For Each c In Drng.Cells
If c = ListBox1 Then
c.EntireRow.Copy
Sheets("Kiert").Range("A1000000").End(xlUp).Offset(1, 0)
Range("F:F" & lastRow).Formula = TextBox1.Value
If c.Value = ListBox1.Value Then
a.Value = "SIKERES"
End If
End If
Next c
End Sub
I insert here an example:
My main problem is I cannot describe a correct range and description of textboxes, and I don't know where I can put it in my code to run it properly.
I tried this:
For Each c In Drng.Cells
If c = ListBox1 Then
c.EntireRow.Copy Sheets("Summary").Range("A1048576").End(xlUp).Offset(1, 0)
Sheets("Kiert").Range("A:A" & lasrRow).Value = TextBox1.Text
If c.Value = ListBox1.Value Then
A.Value = "SIKERES"
End If
End If
Next c
...but its out of range.
It's not very clear what you are trying to do, but the code below will help you paste the values of your textboxes to the relevant column:
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim Drng As Range, c As Range
Dim i As Long
Dim NextFreeRow As Long
Dim srcRange As Range, fillRange As Range
Set Drng = Sheets("Data").Columns("A:A").SpecialCells(xlCellTypeConstants, 23)
For Each c In Drng.Cells 'loop through Column A on Sheet Data
If c = ListBox1.Value Then 'If the cells in Column A Sheet Data matches the selection on your Listbox1 then
NextFreeRow = Sheets("Kiert").Cells(Rows.Count, "A").End(xlUp).Row + 1 'Check the next free row on Sheet Kiert
c.EntireRow.Copy Desination:=Sheets("Kiert").Range("A" & NextFreeRow) 'Paste the entire row from Sheet Data to Sheet Kiert
Range("F" & NextFreeRow).Value = TextBox1.Text 'Copy the contents of TextBox1 to column F
'Add more lines like the one above to copy the values from your Textboxes to the relevant column
TextBox5.Text = "SIKERES"
End If
Next c
End Sub
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.