I am trying to write a VBA code to do lookup in excel.
What I have is two worksheets and want to lookup between these two sheets and lookup result should be present in third sheet. How will be able to do this in VBA.
SHEET1:
CHANGE NUMBER |DATE |
---------------|--------|
1555081 |5/3/2018|
1555083 |5/3/2018|
1555089 |5/3/2018|
1555327 |5/3/2018|
1555381 |5/3/2018|
1555526 |5/3/2018|
SHEET2:
TICKET NO |CLIENT REFERENCE ID|
--------------|-------------------|
T20161103.0040|1555081 |
T20170113.0057|1555526 |
T20170113.0064|1555589 |
T20170125.0035|1555083 |
T20170130.0091|1555526 |
T20170130.0092| |
T20170208.0073| |
My lookup formula will be
= vlookup(sheet1!A1,sheet2!B:B,1,FALSE)
How can I do that in VBA. Any help will be appreciated
Thanks
Abdulquadir
Try this for a start
My lookup formula will be
= vlookup(sheet1!A1,sheet2!B:B,1,FALSE)
.
Sub randomstackmacro()
Dim output As String
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
'This will apply the vba on cell C2 // Please modify this according to your requirements>
Range("C2").Select
Set Sheet1 = ThisWorkbook.Sheets("Sheet1")
Set Sheet2 = ThisWorkbook.Sheets("Sheet2")
output = Application.WorksheetFunction.VLookup(Sheet1.Range("A3"), Sheet2.Range("A:B"), 2, False)
'Output of Vlook up is set to the active cell as an example
ActiveCell.Formula = output
End Sub
OUTPUT
Sub lookuptest()
Worksheets("CA").Range("A:A").Copy Worksheets("OUTPUT").Range("A:A")
On Error Resume Next
Dim cn_Row As Long
Dim cn_Clm As Long
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Dim sheet3 As Worksheet
Set sheet1 = ThisWorkbook.Sheets("CA")
Set sheet2 = ThisWorkbook.Sheets("AT")
Set sheet3 = ThisWorkbook.Sheets("OUTPUT")
With sheet1
sourcelastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
'MsgBox "source file last row is: " & sourcelastrow
End With
Table1 = sheet1.Range("$A$2:$A$" & sourcelastrow) ' Employee_ID Column from Employee table
Table2 = sheet2.Range("B:B") ' Range of Employee Table 1
cn_Row = sheet3.Range("B2").Row ' Change E3 with the cell from where you need to start populating the Department
cn_Clm = sheet3.Range("B2").Column
For Each cl In Table1
sheet3.Cells(cn_Row, cn_Clm) = Application.WorksheetFunction.VLookup(cl, Table2, 1, False)
cn_Row = cn_Row + 1
Next cl
'MsgBox "Done Lookup with Change Number"
Dim id_row As Long
Dim id_clm As Long
Table3 = sheet1.Range("A:B")
id_row = sheet3.Range("C2").Row
id_clm = sheet3.Range("C2").Column
For Each cl In Table1
sheet3.Cells(id_row, id_clm) = Application.WorksheetFunction.VLookup(cl, Table3, 2, False)
id_row = id_row + 1
Next cl
MsgBox "Done"
End Sub
Related
I am trying to copy a value and paste it to another sheet based on criteria of a cell value by iterating a range.
Criteria: if a cell value of a row of the range has "new", copy a value of a different cell of the same row.
For example, look for 'new' in NewProd column, and if found, copy the values of Product AND Desc columns(the values of the two columns) of the same row.
The table looks like this:
Table1
Problem: when pasting the copied value, the first iteration gets the correct value(the yellow row value), however the second iteration gets the same value as the first one. It should be the green row value in the image, but gets the yellow row value.
My code:
Sub AddNewProd()
Dim tbl As ListObject
Dim lr As Long
Dim lr2 As Long
Dim c As Range
Dim rng As Range
Dim prd As Range
Dim desc As Range
Set tbl = Sheets("sheet1").ListObjects("Table1")
'Count the number of the row of the NewProd column.
lr = tbl.Range.Rows.Count
lr2 = Sheets("sheet2").Cells.SpecialCells(xlCellTypeLastCell).Row
Sheets("sheet1").Select
Set rng = Sheets("sheet1").Range("AS2:AS" & lr)
Set prd = tbl.ListColumns("Product").DataBodyRange
Set desc = tbl.ListColumns("Desc").DataBodyRange
For Each c In rng
If c = "New" Then
prd.Offset(1).Resize(1, 2).SpecialCells(xlCellTypeVisible).Copy
Sheets("sheet2").Select
Range("A" & lr2 + 1).Select
ActiveSheet.Paste
lr2 = Sheets("sheet2").Cells.SpecialCells(xlCellTypeLastCell).Row
Application.CutCopyMode = False
End If
Next c
End Sub
If you have Office 365 then you can use the new Filter-Function:
If you want to do it by VBA I suggest the following code:
Option Explicit
Public Enum en_TableColumns
col_Product = 1
col_Desc = 2
col_isNew = 3
End Enum
Private Const ProductStatusToCopy As String = "new"
Sub copyNewProducts()
Dim loSource As ListObject
Set loSource = ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1")
'get source data into array
Dim arrSourceData As Variant
arrSourceData = loSource.DataBodyRange.Value
Dim cntNewProducts As Long
cntNewProducts = Application.WorksheetFunction.CountIf(loSource.ListColumns(col_isNew).DataBodyRange, ProductStatusToCopy)
Dim arrTargetData As Variant
ReDim arrTargetData(1 To cntNewProducts, 1 To 2)
Dim rSourceRow As Long, rTargetRow As Long
For rSourceRow = 1 To UBound(arrSourceData, 1)
If arrSourceData(rSourceRow, col_isNew) = ProductStatusToCopy Then
'copy product data to target array if new
rTargetRow = rTargetRow + 1
arrTargetData(rTargetRow, col_Product) = arrSourceData(rSourceRow, col_Product)
arrTargetData(rTargetRow, col_Desc) = arrSourceData(rSourceRow, col_Desc)
End If
Next
'write target array to sheet2 - writing an array to a sheet is much, much faster than writing cell per cell
With ThisWorkbook.Worksheets("Sheet2").Cells(2, 1)
.CurrentRegion.Clear
.Resize(cntNewProducts, 2).Value = arrTargetData
End With
End Sub
So I have this task
I have to create a database out of two different files
one have discription column and value columns and one have the mapping element for this values
I need by using VBA code to
1- MAP Each value to its Element (Vlookup by description)
2- in the Database i stack the above data into two columns only Element and Value
For example First Workbook Has a sheet that contains
Description : Value 1 : Value 2 : Value 3
Secound workbook Has a sheet that contains
Description : Element 1 : Element 2 : Element 3
So
Element 1 : Value 1 : Element 2 : Value 2 : Element 3 : Value 3
The Data Base should look like
|Element |Value |
|:-------|-----:|
|Element1|Value1|
|Element2|Value2|
|Element3|Value3|
I had this code the copy part is working fine , but I got an error in the Vlookup function
Sub Copy_Paste_Below_Last_Cell()
'Find the last used row in both sheets and copy and paste data below existing data.
'Sub OpenWorkbook()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim wsMapp As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim lLookupLastRow As Long
'Set variables for copy , vlookup and destination sheets
Set wsCopy = Workbooks("A1. Syndicate 623 QMA_20190930_5_0623 with old version table.xlsx").Worksheets("360")
Set wsDest = Workbooks("Reports.xlsm").Worksheets("Old")
Set wsMapp = Workbooks("QMA new format mapping to old.xlsx").Worksheets("360")
'1. Find last used row in the copy range based on data in column D
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "D").End(xlUp).Row
'2. Find first blank row in the destination range based on data in column J
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "J").End(xlUp).Offset(1).Row
'3. Copy & Paste Data
wsCopy.Range("D15:D" & lCopyLastRow).Copy
wsDest.Range("J" & lDestLastRow).PasteSpecial Paste:=xlPasteValues
'vlookup
'1. Find Last used row in the lookup range based on Data in Column B
lLookupLastRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Row
'2. Select Vlookup Start Row
lLookupLastRow = wsDest.Cells(wsDest.Rows.Count, "I").End(xlUp).Offset(1).Row
'3. Vlookup
Dim Table1 As Range
Dim Table2 As Range
Dim cl As Range
Set Table1 = wsCopy.Range("B15:B" & lLookupLastRow)
Set Table2 = wsMapp.Range("C15:D37")
For Each cl In Table1
wsDest.Range("I" & lLookupLastRow) = Application.WorksheetFunction.VLookup(cl, Table2, 2, False)
Next cl
MsgBox "Done"
'Optional - Select the destination sheet
wsDest.Activate
'Sub CloseWorkbook()
End Sub
'''
Sub lookup()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim wsMapp As Worksheet
Dim lLookupLastRow As Long
Dim lLookupRangeLastRow As Long
Dim Table1 As Range
Dim Table2 As Range
Dim cl As Range
Set wsCopy = Workbooks("A1. Syndicate 623 QMA_20190930_5_0623 with old version table.xlsx").Worksheets("360")
Set wsDest = Workbooks("Reports1.xlsm").Worksheets("Old")
Set wsMapp = Workbooks("QMA new format mapping to old.xlsx").Worksheets("360")
'VLookup
'1. Find Last used row in the lookup range based on Data in Column B
lLookupRangeLastRow = wsCopy.Cells(wsCopy.Rows.Count, "C").End(xlUp).Row
'2. Select Vlookup Start Row
lLookupLastRow = wsDest.Cells(wsDest.Rows.Count, "I").End(xlUp).Offset(1).Row
'3. Vlookup
Set Table1 = wsCopy.Range("C15:C" & lLookupRangeLastRow)
Set Table2 = wsMapp.Range("C15:D38")
For Each cl In Table1
wsDest.Range("I" & lLookupLastRow) = Application.VLookup(cl, Table2, 2, False)
lLookupLastRow = wsDest.Cells(wsDest.Rows.Count, "I").End(xlUp).Offset(1).Row
Next cl
MsgBox "Done"
End Sub
I need to create a VBA VlookUp that will go through Col A to H in a Sheet2 tab(the table_array), match it with column V(look_up value) in Sheet 1 and put the matching results(which is the column index and its in column 7) in cell AF. I was able to test this for a very small range of values, however it doesnt work for my whole datasets. Column V has over 15000 cells! Below is my code so far but it returns an error. Please help
Sub ADDCLM()
Dim table_Row as Long
Dim table_Clm as Long
Dim LastRow as Long
LastRow = .Cells(.Rows.Count, "V").End(xlUp).Row
Table1 = Sheet1.Range("V2:V" & LastRow)
Table2 = Sheet2.Range("A:H")
New_Row = Sheet1.Range("AF2").Row
New_Clm = Sheet1.Range("AF2").Column
For Each c1 in Table1
Sheet1.Cells(New_Row, New_Clm) = Application.WorksheetFunction.VLookup(c1, Table2, 7, False)
New_Row = New_Row + 1
Next c1
End Sub
In Excel, this is how the formula looks like: e.g for Cell AF2 =VLOOKUP(V2;Sheet2!A:H;7;FALSE)
I keep getting runtime error 424 on the line table2 = ...
So, I was able to find a solution to my problem. I renamed my Sheet2 to reflect the sheet name then made some changes to the code with different sources I saw online.
Sub ADDCLM()
Dim table2 As Range
Set table2 = Sheets("RD data").Range("A:H")
Dim lastRow As Long
With Sheet1
lastRow = .Cells(.Rows.Count, "V").End(xlUp).Row
With .Range("AF2:AF" & lastRow)
.FormulaR1C1 = "=VLOOKUP(RC22," & table2.Address(, , xlR1C1, True) & ", 7, False)"
.Value = .Value
End With
End With
End Sub
I want to fill a range of n rows and 3 columns with 3 formulas, one in each column.
The first column should contain a date range.
I fill it this way:
Sub FillDate()
Dim startDate As Date
Dim endDate As Date
Dim row As Long
startDate = "01.08.2019"
endDate = "07.08.2019"
row = 2
Do Until startDate = endDate + 1
Range("A" & row).Value = startDate
startDate = startDate + 1
row = row + 1
Loop
End Sub
This gives me the A column with dates from 01.08.2019 to 07.08.2019 starting from the second row.
In columns B and C I'd like to specify tow formulas.
Formula for column B should look as follows:
=COUNTIF('Sheet (i)'!G$2:G$5000, $A2)
where i is an iterator so that formula in B2 should look as
=COUNTIF('Sheet (1)'!G$2:G$5000, $A2)
and formula in B3 should look as
=COUNTIF('Sheet (2)'!G$2:G$5000, $A3)
and so forth.
This formula looks up for the value in cell A2 and calculates how many times this value is found in the range G$2:G$5000 on the sheet named Sheet (1).
Formula for column C should look as follows:
=ROUND(MEDIAN($B$2:$B$n), 0)
where n is the number of rows in column A on the current sheet.
Like
=ROUND(MEDIAN($B$2:$B$8), 0)
I've come with the following, ehm, solution:
Sub Fill()
Dim strFormulas(1 To 2) As Variant
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim i As Integer
'Application.ScreenUpdating = True
With ThisWorkbook.Sheets("Test")
strFormulas(1) = "=COUNTIF('Sheet (1)'!G$2:G$5000, $A2)"
strFormulas(2) = "=ROUND(MEDIAN($B$2:$B$8), 0)"
.Range("C2:D2").Formula = strFormulas
.Range("C2:D8").FillDown
End With
End Sub
However, this only fills the column C with proper formula.
Question: how do I fill the column B so that B2 cell contains =COUNTIF('Sheet (1)'!G$2:G$5000, $A2), B3 cell contains =COUNTIF('Sheet (2)'!G$2:G$5000, $A2) and so on up to =COUNTIF('Sheet (8)'!G$2:G$5000, $A2)?
Thank you in advance.
Sub Fill()
Dim strFormula_template As String
Dim strFormulas(1 To 2) As Variant
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim iCt As Integer
'Application.ScreenUpdating = True
With ThisWorkbook.Sheets("Test")
strFormula_template = "=COUNTIF('Sheet (count)'!G$2:G$5000, $Axx)"
strFormulas(2) = "=ROUND(MEDIAN($C$2:$C$8), 0)"
For iCt = 1 To 7
strFormulas(1) = Replace(strFormula_template, "count", iCt)
strFormulas(1) = Replace(strFormulas(1), "xx", iCt + 1)
.Range("C1:D1").Offset(iCt, 0).Formula = strFormulas
Next
End With
End Sub
I'm trying to lookup values from Master Data worksheet check if "CONDITION 1" is true and to populate with "Value" each column with header "SITE # 1" in Project Visit worksheet having empty row using VBA.
Note that number of row and columns will remain variable, hence I'm want to use .UsedRange to cut down unnecessary loops.
Screenshots
Code
Private Sub CommandButton1_Click()
Set rng1 = Range("b3")
On Error Resume Next
Dim P_Row As Long
Dim P_Clm As Long
Table1 = Sheet2.Range("A:A") ' LOOKUP VALUE
Table2 = Sheet1.Range("A:B") ' Range of LOOKUP VECTOR
Dept_Row = Sheet2.Range(rng1.Address).Row ' CURRENT DUE FOR THE MONTH
Dept_Clm = Sheet2.Range(rng1.Address).Column
For Each cl In Table1
Sheet2.Cells(P_Row, P_Clm) = Application.WorksheetFunction.VLookup(cl, Table2, 2, False)
Dept_Row = P_Row + 1
Next cl
End Sub