I am attempting to add VLookups into a worksheet using VBA. I have managed to get my code sort of working with the help of this group but there are still errors as outlined below.
1st VLOOKUP in Column AA
Typed formula would look : =VLOOKUP(B2,'Supplier Audit Report'!C:AB,26,FALSE)
2nd VLOOKUP in Column BB
Typed formula would look : =VLOOKUP(U2,Pivot!A1:B1802,2,FALSE)
Where the cells A1:B1802 is a pivot table defined as pvt
(the size of the pivot will be different every time the macro is run so I would prefer to reference to the defined pivot table rather then A1:B1802)
I want the formula to be filled down to the end of the data in the table (again this will be to a different cell each time.
My code is as follows. I have gone through various iterations and this iteration succeeds in getting a VLOOKUP formula into AA, but not AB. However, the formula is as follows in EVERY cell of the column (i.e. the xcell reference is not changing as the formula loops and as it is text with no " " around it, it isn't bringing back a value.)
=VLOOKUP(SEUR0310,'Supplier Audit Report'!C:AB,26,FALSE)
Where SEUR0310 isn't even the value in B2. I want the formula to display:
=VLOOKUP(B2,'Supplier Audit Report'!C:AB,26,FALSE) in cell AA2
=VLOOKUP(B3,'Supplier Audit Report'!C:AB,26,FALSE) in cell AA3 and so on
When it finishes the first loop for AA, I get an error for the AB Vlookup as follows: Application-defined or object defined error. Run-time error 1004.
Does anyone have any advice on how to fix the code to get this to work. I am still exceptionally new to VBA so all your help is very much appreciated.
Current Code
Sub Adding_VLOOKUPS()
Dim pvt As PivotTable
Dim sAP As Worksheet
Dim sDB As Worksheet
Dim sSAR As Worksheet
Dim lastrow As Long
Dim rMT As String
Dim rPO As String
Dim xcell As Variant
Dim ycell As Variant
Set sAP = Sheets("AP Invoice Lines")
Set sDB = Sheets("DashBoard PO Report")
Set sSAR = Sheets("Supplier Audit Report")
Set pvt = Sheets("Pivot").PivotTables("PivotTable1")
lastrow = sAP.Cells(Rows.Count, "B").End(xlUp).Row
rMT = "AA2:AA" & lastrow
rPO = "AB2:AB" & lastrow
Range("AA1").Select
ActiveCell.FormulaR1C1 = "Matching Type"
Range("AB1").Select
ActiveCell.FormulaR1C1 = "PO Value"
Columns("Y:Y").Select
Selection.Copy
Columns("AA:AB").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
For Each xcell In sAP.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
Range(rMT).Formula = "=VLOOKUP(" & xcell & ",'Supplier Audit Report'!C:AB,26,FALSE)"
Next xcell
For Each ycell In sAP.Columns("U").Cells.SpecialCells(xlCellTypeConstants)
Range(rPO).Formula = "=VLOOKUP(" & ycell & ",'Pivot'!A1:B1802,2,FALSE"
Next ycell
End Sub
A couple of things when reading through the code:
1) I'm not sure you need to write rmt = "AA2:AA". It might be enough to write rmt = "AA"
Range("AA1").Select
ActiveCell.FormulaR1C1 = "Matching Type"
Range("AB1").Select
ActiveCell.FormulaR1C1 = "PO Value"
Columns("Y:Y").Select
Selection.Copy
Columns("AA:AB").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Why do you need this code block? It looks like you are making column labels that don't really have anything to do with putting the formula in the columns.
Also, in the for each loop you need a next statement to end the loop. This way excel knows when to iterate the cell; to go from one cell to the next cell. The work on each cell is done within the loop, but the loop needs an opening (for each cell in range) and a closing (next)
Are you looking for an explanation on how those methods work? (IE how the loop works or how the range method works?)
Related
Very new to VBA (and coding in general), trying to teach myself with the info that I can find online.
Writing a macro that will copy over employee performance data that is entered on the MAIN sheet, row by row, over to the LOG sheet of a workbook.
Up to that point, I've managed to make it work fine. But now I want to add a FIND function to determine whether a row of data already exists on the LOG sheet, so that I can then use an IF... THEN statement:
If data for a particular employee AND date does not exist yet, then that row is copied over to first empty row of the LOG sheet.
If it does exist already, the existing row of data on the LOG sheet will be overwritten.
This is what I've got:
Sub CopyToLog()
Dim RowCount As Integer
Sheets("MAIN").Select
For RowCount = 1 To Range("WeeklyData").Rows.Count
With Sheets("LOG").Range("A:B")
Set Dupe = .Find(Sheets("MAIN").Range("B5:C5").Offset(RowCount - 1, 0), LookIn:=xlValues)
Range("B5:F5").Offset(RowCount - 1, 0).Select
Selection.Copy
Sheets("LOG").Select
If Dupe Is Nothing Then
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
Dupe.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End With
Sheets("MAIN").Select
Next RowCount
End Sub
This does not work however. It looks like the problem is in the Find function:
With Sheets("LOG").Range("A:B")
Set Dupe = .Find(Sheets("MAIN").Range("B5:C5").Offset(RowCount - 1, 0), LookIn:=xlValues)
I need to check for both Date and Employee (columns B & C on the MAIN sheet vs columns A & B on the LOG sheet), however it seems the formula as it is here is only comparing the first column (Date). As a result, data for one employee now gets overwritten by the next employee if it is for the same date.
Can you only use Find to find a single-cell value, not for a range of two neighbouring cells? If so, any tips on how to get around this?
It sounds like helper cells can accomplish what you're after. I'm assuming you have space in cell D5 next to Sheets("MAIN").Range("B5:C5"). Enter in the formula =B5&C5 into D5. Doing this will give you the combination of the two and allow you to achieve the lookup you want. You'll also need a helper column for your lookup range on your log sheet. If your information starts on row 10 in cell C10 enter =A10&B10, copy down as needed. With these in place you can now use them for your check. I altered your code to use the helper cells.
Sub CopyToLog()
Dim main As Worksheet
Set main = ThisWorkbook.Worksheet("MAIN")
Dim log As Worksheet
Set log = ThisWorkbook.Worksheets("LOG")
Dim searchRange As Range
Set searchRange = log.Range("C:C") 'Helper Column
Dim RowCount As Integer
For RowCount = 1 To main.Range("WeeklyData").Rows.Count
Dim lookFor As String
lookFor = main.Range("D5").Offset(RowCount - 1, 0).Value2 'Uses helper cells
Dim dupe As Range
Set dupe = searchRange.Find(lookFor, LookIn:=xlValues)
Dim copyInfo As Range
Set copyInfo = searchRange.Range("B5:F5").Offset(RowCount - 1, 0)
Dim destination As Range
If dupe Is Nothing Then
Set destination = log.Range("A" & Rows.Count).End(xlUp).Offset(1)
Else
Set destination = dupe
End If
destination.Resize(ColumnSize:=copyInfo.Columns.Count).Value2 = copyInfo.Value2
Next
main.Select
End Sub
Work with the objects themselves. I removed the .Select and Selection. pairs. Not using them will make your code more readable and faster. To get started the macro recorder will use them but be aware you can sandwich them out (IE Range("M10").Select followed by Selection.Copy is best written as Range("M10").Copy).
I replaced any unqualified Range variables with qualified ones. Range is implicity using the ActiveSheet, in essence it's ActiveSheet.Range. Qualifying it with a worksheet object like main.Range("A5") lets you know exactly which sheet it's coming from. This saves you from hair pulling moments later on.
destination.Resize(ColumnSize:=copyInfo.Columns.Count).Value2 = copyInfo.Value2 is doing the same as copying the values directly. Resize is used to make both ranges be the same size.
I'm looking to import data from another file (combinedWorkbook) to my master file (the file which is running the code) using a vlookup. I then need it to drag the vlookup down to the bottom row of data (using column M in the masterfile as a reference to when the data ends) with cell I15 being the starting point for the vlookup in the masterfile.
The problem I'm having is that when running the macro the vlookup is happening in cell M10 in my masterfile, not dragging down the vlookup to the end of the data and not referencing the combinedWorkbook.
Any help would be appreciated.
This is what I got so far
Dim combinedBook As Workbook
Dim filter As String
Dim caption As String
Dim combinedFilename As String
Dim combinedWorkbook As Workbook
Dim targetWorkbook As Workbook
MsgBox ("Select Unpaid Capital Extract")
Set targetWorkbook = ThisWorkbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file"
combinedFilename = Application.GetOpenFilename(filter, , caption)
Set combinedWorkbook = Application.Workbooks.Open(combinedFilename)
ThisWorkbook.Activate
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-8],combinedWorbookSheet1!R1C1:R700000C2,2,0)"
Range("M16").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlUp)).Select
Range("I15:I60297").Select
Range("I60297").Activate
Selection.FillDown
Range("I15").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.End(xlUp).Select
Range("I15").Select
combinedWorkbook.Close False
There are simply too many unknowns in your code to give a specific answer.
Some observations:
1) Always use Option Explicit at the top of your code, it will pick up mistakes and inconsistencies for you.
2) Watch out for unused variables declared in your code
3) Always specify which workbook and worksheet you are working with; don't just put Range ... or Cells.... this leads to all sorts of bugs.
4) Your VLOOKUP syntax for working with another workbook needs to be of the order
'[" & combinedWorkbook.Name & "]Sheet1'
5) xlsx are not text files btw re: your filter
6) For the rest i.e. where you want formulas to go, how you are determining last row etc I am just having to guess. Be specific when coding and try bullet pointing pseudo code first so you are clear what is going on at each stage.
Option Explicit
Sub test()
Dim filter As String
Dim caption As String
Dim combinedFilename As String
Dim combinedWorkbook As Workbook
Dim targetWorkbook As Workbook
MsgBox "Select Unpaid Capital Extract"
Set targetWorkbook = ThisWorkbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file"
combinedFilename = Application.GetOpenFilename(filter, , caption)
Set combinedWorkbook = Application.Workbooks.Open(combinedFilename)
'Assuming M is used to find last row in targetWorkbook
Dim lastRow As Long
With targetWorkbook.Worksheets("Sheet1") 'this wasn't specified (specify appropriate sheet name)
lastRow = .Cells(.Rows.Count, "M").End(xlUp).Row
'Assuming I is where formula is being put
.Range("I15:I" & lastRow).FormulaR1C1 = _
"=VLOOKUP(RC[-8],'[" & combinedWorkbook.Name & "]Sheet1'!R1C1:R700000C2,2,0)"
combinedWorkbook.Close False
End With
End Sub
As I understood you need to apply a vlookup formula in your master file gathering data from another workbook.
The proper strucutre is as followed:
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[8],[Book1]Sheet1!R1C5:R23C6,2,FALSE)"
The first bold text is the place of the value you are looking for, relative to the active cell.
The second bold text is the position of your reference table in your other workbook ( here it is book 1).
You can apply this formula to your masterfile by using a loop.
Dim lastRow as Integer
lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "M").End(xlUp).Row
endCount = 15 + lastRow
For i = 15 to endCount
ActiveSheet.Cells(i,13).FormulaR1C1 = "=VLOOKUP(RC[-8],[combinedWorkbook]Sheet1!R1C1:R700000C2,2,FALSE)"
next i
This will apply the vlookup formula in the column I starting row 15 searching for the value in the same row but 8 column before (column "A") and will apply for as many row as there are value in the column M.
here's the code I currently have in VBA (Excel) at the moment. Most of it has come from macro recordings that I've made. What I'm looking for is to be able to insert for example, row 10 as just 10 in the inputbox without having to put it in as 10:10. Is there a way for me to edit my current code to allow this? I've tried using Rows("TargetRow:TargetRow") but that gives odd results.
Dim TargetRow As Variant
TargetRow = InputBox("Insert row # where data should be inserted. This should take the format XX:XX (e.g. 90:90 for row 90)", "All Industries Row", "XX:XX")
wbThis = ThisWorkbook.Name
Windows(wbThis).Activate
Rows(TargetRow).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromAbove
Windows("otherworksheet.xlsx").Activate
Range("A119:J119").Select
Application.CutCopyMode = False
Selection.Copy
Windows(wbThis).Activate
Range(TargetRow).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Use following sub to select rows using inputbox
Sub SelectRow()
Dim lnRow As Long
lnRow = InputBox("Enter Row number.", "Row Input")
Rows(lnRow & ":" & lnRow).Select
End Sub
If you need a Range from user input, the simplest way is to use the Excel version Application.InputBox with a type of '8' (see the documentation here).
Dim TargetRow As Range
Set TargetRow = Application.InputBox("Select the row where data should be inserted.", _
"All Industries Row", , , , , , 8)
Debug.Print TargetRow.Address
Note that you should probably also get rid of the Select and Activate calls and use your object references directly.
I am having problems with getting a loop to run.
I have a Source1 spreadsheet with a list of values in Column A on the CC's tab. Each number is to be copied individually into Cell B1 on the Template tab of the Source2 spreadsheet.
Cell B1 triggers a consolidation of information (mainly indexed info) and displays it in a template - an aggregate picture of lots of background data. I then Copy A1:K71, and paste this into the Output tab of the Source1 spreadsheet.
I want to work down the list in Column A of the CC's tab, and append each output from the Source2 spreadsheet into the Output tab automatically.
I have the copy/paste working, but I am having problems with the loop.
Selection.Copy
Windows("Source2.xlsx").Activate
Range("B1").Select
ActiveSheet.Paste
Range("A1:K71").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Source1.xlsm").Activate
Sheets("Ouput").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
#Andrew, after reading and re-reading your question, I don't think a loop of any kind is necessary. The macro-recorder results you gave above provide information about how you can solve this. I tested this by creating a Source1 Workbook with values placed in column A on a sheet labeled CC's. I also added a sheet labeled Output. Then, I opened a second Workbook with a sheet labeled Template. Here is the sub-procedure I used to produce the result I think you are describing above:
Sub AndrewProject()
' COMMENT: Declare variables used throughout this procedure
Dim InitialVals As Range
Dim OutputVals As Range
Dim FinalResults As Range
Dim FinalOutput As Range
Dim cell As Variant
' COMMENT: Set the range objects so they are easier to manipulate
Set InitialVals = Workbooks("Source1").Worksheets("CC's").Range("A2:A72")
Set OutputVals = Workbooks("Source2").Worksheets("Template").Range("B2:B72")
Set FinalResults = Workbooks("Source2").Worksheets("Template").Range("A2:K72")
Set FinalOutput = Workbooks("Source1").Worksheets("Output").Range("A2:K72")
' COMMENT: This line copies the values in Source1 Workbook and pastes them into Source2 Workbook
InitialVals.Copy
OutputVals.PasteSpecial xlPasteValues
' COMMENT: Additional code goes here to create the desired output. To simplify things, I put a
' function in Source2, column K that concatenates the string "Output" with InitialVals copied
' from Source1. To emulate your Source2 Template, I placed random values between 1 and 1000 in
' Cells A2:A72 and C2:J72.
' COMMENT: Copy the FinalResults from Source2 "Template" tab into the Source1 "Output" tab
FinalResults.Copy
FinalOutput.PasteSpecial xlPasteAll
End Sub
OK #Andrew...this has got to be my last attempt. I believe this answers your question.
Sub AutomateIt()
' Declare your variables
Dim cell As Range
Dim Src1CC As Range
Dim Src2Template As Range
Dim Src2Calcs As Range
Dim Src1Output As Range
Dim NextRow As Long
Dim count As Integer
' Set the ranges so they can be manipulated
Set Src1CC = Workbooks("Source1").Worksheets("CC").Range("A1")
Set Src2Template = Workbooks("Source2").Worksheets("Template").Range("B1")
Set Src2Calcs = Workbooks("Source2").Worksheets("Template").Range("A1:K72")
Set Src1Output = Workbooks("Source1").Worksheets("Output").Range("A1:K72")
Src2Template.ClearContents
count = 0
' Loop through all the cells and calculate stuff
For Each cell In Src1CC.Range(Src1CC, Src1CC.End(xlDown))
'Determine the next empty row (plus a space for readability)
NextRow = Cells(Rows.count, 1).End(xlUp).Row + 2
'Send a copy of the Src1CC cell value to the Src2Template
cell.Copy Src2Template
'Re-calculate A1:K72 based on cell value
Src2Calcs.Calculate
'Copy Src2Calcs results and paste to Source1 Output
Src2Calcs.Copy
Src1Output.PasteSpecial xlPasteValues
count = count + 1
MsgBox "You have pasted " & count & " results."
'Change Src1Output Range so that the next paste is the next blank row
'plus one additional row for readability.
Set Src1Output = Workbooks("Source1").Worksheets("Output").Range(Cells(NextRow, 1), Cells(NextRow, 11))
Next cell
End Sub
I have a table put together as a database. I am trying to write a macro to search a System Size column in my table to find "2500" then search a Standard column to find "Standard" then search a Category column to find "FL" I then want to copy the value from a Select Item column pertaining to the row these values were found in to another sheet. For example, the macro will search Column E (System Size) for all "2500", then it will search Column F (Standard) for all "Standard", then it will search Column G (Category) for all "FL". I then want it to copy the values from Column C (Select Item) for every line that meets these requirements and paste it to another sheet. Following is the code I have so far but I can only get it to search one cell and not the entire column. There is probably a better way to go about it but this is the only way I have found that works.
Sub ImDoingMyBest()
'
' ImDoingMyBest Macro
'
'
If Sheets("Database").Range("E2").Value Like "*2500*" Then
Sheets("Database").Range("C2").Copy
Sheets("Quote Sheet").Select
Range("B26").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End If
End Sub
The way to search the whole column is to use a for-loop; for instance:
For i = 1 To 10000
If Sheets("Database").Range("E" & i).Value Like "*2500*" Then
Sheets("Database").Range("C" & i).Copy
...
...
End If
Next i
Alternatively (and my preference) use the Cells(row, column) format rather than Range - this avoids having to concatenate the Range reference. This would take
Range("E" & i)
and change to
Cells(i, 5)
which is neater code (IMO).
Following up on Siddarth Rout's comments, the following code uses Autofilter to isolate the rows in the "Database" sheet that meet your criteria, and then copies the corresponding values in column C to a range beginning in cell B26 of the sheet named "Quote Sheet".
Sub FilterAndCopy()
Dim dataWs As Worksheet
Dim copyWs As Worksheet
Dim totRows As Long
Dim lastRow As Long
Set dataWs = Worksheets("Database")
Set copyWs = Worksheets("Quote Sheet")
With dataWs
.AutoFilterMode = False
With .Range("C:G")
.AutoFilter Field:=3, Criteria1:="2500"
.AutoFilter Field:=4, Criteria1:="Standard"
.AutoFilter Field:=5, Criteria1:="FL"
End With
End With
totRows = dataWs.Range("C:C").Rows.count
lastRow = dataWs.Range("C" & totRows).End(xlUp).Row
dataWs.Range("C2:C" & lastRow).Copy
copyWs.Range("B26").PasteSpecial Paste:=xlPasteValues
dataWs.AutoFilterMode = False
End Sub