I wish to vlookup a pivot table from one workbook to another but I get the following error:
The source workbook looks like this (Sheet Piv_Repos):
The target workbook looks like this (Sheet Nominator):
This is my code:
Dim sourceBook3 As Workbook
Dim Srepfile3 As String
MsgBox ("Select Adjusted data")
Srepfile3 = Application.GetOpenFilename
Set sourceBook3 = Application.Workbooks.Open(Srepfile3, UpdateLinks:=0)
Dim sourcesheet As Worksheet
Set sourcesheet = sourceBook3.Sheets("Piv_Repos")
Dim destSheet1 As Worksheet
Set destSheet1 = ThisWorkbook.Sheets("Nominator")
Dim lastrow As Long
lastrow = destSheet1.Range("B" & Rows.Count).End(xlUp).Row
Set myrange = sourcesheet.Range("A:B")
For i = 35 To lastrow
destSheet1.Cells(i, 8) = Application.WorksheetFunction.VLookup(destSheet1.Cells(i, 2), myrange, 2, False)
Next I
This seemingly exact code works fine when I use it between other workbooks though.
Really appreciate help. Thank you.
The problem is in the WorksheetFunction, not in the two workbooks.
Try something as small as these:
Option Explicit
Sub TestMeWS()
Dim myRange As Range
Set myRange = Worksheets(1).Range("A:B")
Debug.Print Application.WorksheetFunction.VLookup("something", myRange, 2, 0)
End Sub
Sub TestMeAPP()
Dim myRange As Range
Set myRange = Worksheets(1).Range("A:B")
Debug.Print Application.VLookup("something", myRange, 2, 0)
End Sub
You would notice, that if "something" is not present in myRange, you get the 1004 error in the TestMeWS. In the second case, you get error 2042 in the immediate window, but it works.
Related
I'm trying to use vlookup() function under for loop condition, but the value only follow only the first row value. This is my code. Sorry, the code is quite messy; I'm still learning VBA.
Sub vlookup_Click()
Application.ScreenUpdating = False
Dim result As String
Dim i As Long
Dim iLast As Long
Dim result1 As String
Dim sheet As Worksheet
Dim sheet1 As Worksheet
Dim WrkSht As String
WrkSht = "Sheet1"
iLast = ActiveWorkbook.Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Set sheet = ActiveWorkbook.Sheets("Sheet1")
Set sheet1 = ActiveWorkbook.Sheets("InventoryReport")
For i = 10 To iLast
result = Application.WorksheetFunction.VLookup(sheet.Range("$B$10"), _
sheet1.Range("$B$10:$Q$48"), 16, False)
Sheets(WrkSht).Cells(i, 9).Value = result
Next i
End Sub
Below picture shows the result.Any idea to solve this?
Expected and Current Result:
So let's consider dumping the VLOOKUP() option. We are using VBA, so we have more power when it comes to looking up ranges.
I think we should go with using the range.Find() method here. Set this object, use the Row() property to match the Q column on that range, and return it to your I column in ws1.
Try this
Sub vlookup_Click()
Application.ScreenUpdating = False
Dim i As Long
Dim iLast As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim findRng As Range
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("InventoryReport")
'Changed ActiveWorksheet to ws1 for your iLast
iLast = ws1.Range("A" & Rows.Count).End(xlUp).Row
For i = 10 To iLast
Set findRng = ws2.Range("B:B").Find(ws1.Cells(i, "B"), , xlValues, xlWhole)
If Not findRng Is Nothing Then
ws1.Cells(i, "I") = ws2.Cells(findRng.Row, "Q")
Else
ws1.Cells(i, "I") = 0
End If
Set findRng = Nothing
Next i
Application.ScreenUpdating = True
End Sub
I see you use the excel worksheet function, but use the form of formulaR1C1 will be better. And record the Macro will free you from calculate the row# for the formula.
how to do:
You can just video this operation to get that code in your excel by click Tab "Developer" in your
excel/"record Macro" then input the formular in the cell then "stop recording" then Alt+F11 to get to
access the code of the vlookup formula:
ActiveCell.FormulaR1C1 = "=VLOOKUP(R10C2,R[3]C[-1]:R[41]C[11],16,0)"
I have this formula on the first column in my sheet:
=IFERROR(INDEX(Plan2!$A$1:$K$20;MATCH(Plan3!B2;Plan2!$B$1:$B$20;0);MATCH(Plan3!$A$1;Plan2!$A$1:$K$1;0));"")
And it fits perfectly for what I want: look up on Plan2 (my databse) for the information on column B of Plan3 by matching the result by matching the header of table.
What I want know is to translate this to a VBA that do the same thing. This is what I've tried so far:
Sub AlocSubs()
Dim i As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Sheets("Plan2")
Set ws2 = Sheets("Plan3")
For i = 2 To 20
ws2.Cells(i, 1).Value = Application.WorksheetFunction.Index(ws1.Range("A1:K20"), .match(ws2.Range("B2"), ws1.Range("B1:B20"), 0), .match(ws2.Range("A1"), ws1.Range("A1:K1"), 0))
Next i
End Sub
When I try to run I get the message:
Compilation error: Reference is not valid.
And I get this line highlighted:
Sub AlocSubs()
This is the first time that I try to translate a formula do a code in VBA so I really don't know what is going wrong.
Any suggestions will be appreciated.
Try this:
Sub AlocSubs()
Dim i As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim strFormula As String
Set ws1 = Sheets("Plan2")
Set ws2 = Sheets("Plan3")
strFormula = "=IFERROR(INDEX(Plan2!$A$1:$K$20;MATCH(Plan3!B2;Plan2!$B$1:$B$20;0);MATCH(Plan3!$A$1;Plan2!$A$1:$K$1;0));"""")"
With ws2
With .Range(.Cells(2, 1), .Cells(20, 1))
.Formula = strFormula
.Value = .Value
End With
End With
End Sub
Note: I've not tested your formula. Code shows how the formula result can be displayed using VBA.
You used .match, but you don't have With statement before. You also don't use i in your formula. I guess it should be like this:
With Application.WorksheetFunction
For i = 2 To 20
ws2.Cells(i, 1).Value = .Index(ws1.Range("A1:K20"), .Match(ws2.Range("B" & i), ws1.Range("B1:B20"), 0), .Match(ws2.Range("A1"), ws1.Range("A1:K1"), 0))
Next i
End With
I have to find and replace rows in sheet 1 given matching cell value in the same column in sheet2. The column number is 4.
HELPPP!!!
This is what I have right now and I get an error on next x.
Sub DeleteRows()
Dim wb As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Set wb = ActiveWorkbook
Set ws = Sheets(Sheet1)
Set ws2 = Sheets(sheet2)
With wb
For i = 1 To ws2.Cells(Rows.Count, 4).End(xlUp).Row
Dim lookupvalue As String
lookupvalue = ws2.Cells(i, 4).Value
For x = 1 To ws1.Cells(Rows.Count, 4).End(xlUp).Row
Dim rng As range
For Each rng In range("D:D")
If InStr(1, rng.Value, "lookupvalue") > 0 Then
rng.Delete
End If
Next x
exitloop:
Next i
End With
End Sub
As A.S.H. said, the code needs a little improvement:
1) The two inner loops need to be combined.
2) The new inner loop should go from the bottom up, due to the fact that you are deleting the cell, This is probably why you have the second inner loop but that just adds time to the sub.
3) you are currently only deleting the one cell at a time, any data around it will remain. This may be what you want and so I left it, but if you meant to delete the entire row then uncomment the line that does that.
4) when testing with the instr function the variable should not be in quotes, with the variable in quotes it will look for that specific word "lookupvalues" and not the value assigned to that variable.
5) The with block that was being used did nothing. when using the with block the line that use it need to start with a '.' for example: on your code the with was with the workbook so every time a worksheet is used it should start with a "." like .ws1... and so forth. But by declaring the sheets using the workbook, this is no longer needed.
Sub DeleteRows()
Dim wb As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim rng As Range
Dim lookupvalue As String
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")
Set ws2 = wb.Sheets("sheet2")
For i = 1 To ws2.Cells(Rows.Count, 4).End(xlUp).Row
lookupvalue = ws2.Cells(i, 4).Value
For x = ws.Cells(Rows.Count, 4).End(xlUp).Row To 1 Step -1
Set rng = ws.Cells(x, 4)
If InStr(1, rng.Value, lookupvalue) > 0 Then
rng.Delete 'this only deletes the cell
'You may want this instead
'rng.entirerow.delete
End If
Next x
Next i
End Sub
I would like to propose an alternative way to handle this using a For Each Loop and the Find Method of the Range object.
Sub DeleteRows()
Dim wb As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim lookup_rng As Range
Dim lookupvalue As String
Dim search_rng As Range
Dim rng As Range
Dim match_rng As Range
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")
Set ws2 = wb.Sheets("Sheet2")
Set lookup_rng = Application.Intersect(ws2.Range("D:D"), ws.UsedRange)
Set search_rng = Application.Intersect(ws.Range("D:D"), ws2.UsedRange)
For Each rng In lookup_rng.Cells
lookupvalue = rng.Value
With search_rng
Set match_rng = .Find(lookupvalue, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlPrevious)
Do Until NoMoreMatches(match_rng)
match_rng.Delete 'Or match_rng.EntireRow.Delete if you want to delete the entire row.
Set match_rng = .FindPrevious
Loop
End With
Next
End Sub
Private Function NoMoreMatches(MatchRng As Range) As Boolean
NoMoreMatches = MatchRng Is Nothing
End Function
This approach is a little bit more wasteful then that of Scott Craner since the Find method always starts from the end of the range. However, I think it has the advantage that it is easier to read, i.e. that the code more directly shows what it is supposed to do.
Moreover, using this version you could extract the loops into a separate Sub you can use for arbitrary lookup and search ranges.
I have a Worksheet named 'Abschluss'. In this worksheet I use filter to get the data-range I want to handle with my vba script. So i only want to handle the visible rows.
My vba Script looks like
For Each i In Worksheets("Abschluss").SpecialCells(xlCellTypeVisible).Rows
If (WorksheetFunction.CountIf(Range("B2:B" & i), Cells(i, 2)) = 1) Then _
Umsetzung_Kapitel_1.AddItem Cells(i, 2)
Next
This doesn't work, I get runtime-error 438. Do you know where the problem is?
I assume that Worksheets("Abschluss").SpecialCells(xlCellTypeVisible).Rows returns the wrong data-type, but I couldn't fix it.
It looks like you are trying to populate a combobox or a listbox with unique items, possibly in a UserForm?
Try this
Private Sub UserForm_Initialize()
Dim cUnique As Collection
Dim Rng As Range
Dim Cell As Range
Dim sh As Worksheet
Dim vNum As Variant
Set sh = ThisWorkbook.Sheets("Abschluss")
Rws = sh.Cells(Rows.Count, "B").End(xlUp).Row
Set Rng = sh.Range(sh.Cells(2, 2), sh.Cells(Rws, 2)).SpecialCells(xlCellTypeVisible)
Set cUnique = New Collection
On Error Resume Next
For Each Cell In Rng.Cells
cUnique.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0
For Each vNum In cUnique
ComboBox1.AddItem vNum
Next vNum
End Sub
Change to
Dim i As Long
Dim colCount As Long: colCount = Worksheets("Abschluss").SpecialCells(xlCellTypeVisible).Rows.Count
For i = 1 to colCount
....
I am trying to loop through all the worksheets in the activeworkbook to perform a repetitive task.
I currently have the code below:
Sub sort_sectors()
Dim i As Integer
Dim rng As Range
Dim SortRng As Range
Dim rng1 As Integer
Dim ws As Worksheet
Dim wb As Workbook
Dim LastCol As Long
Dim LastRow As Long
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
'This is marking several of the sheets of which I do not want to run the sub
If ws.Range("a9").Value = "x" Then
NextIteration:
End If
'Reference point is rng1 to select the desired range
With Range("a1:t100")
rng1 = .Find(what:="sector", LookIn:=xlValues).Row
End With
'return the row number for the sector header
LastCol = ws.Cells(20, ws.Columns.Count).End(xlToLeft).Column
LastRow = ws.Range("a15").End(xlDown).Row
'I am going to add the code below to finish out the task that I want to complete
Next
End Sub
I am sure the problem is that I'm misunderstanding something about how the for each loop actually works. Hopefully someone's answer will allow to better understand.
I really appreciate any help on this.
I made some edits to the code, and now I actually do have an error :) I tried making the changes you suggested for the "with ws.range etc..." piece of the code, and I get the object error 91.
Below is my new and "improved" code.
Sub sort_sectors()
Dim i As Integer
Dim rng As Range
Dim SortRng As Range
Dim intAnchorRow As Integer
Dim intMktCapAnchor As Integer
Dim intSectorAnchor As Integer
Dim ws As Worksheet
Dim wb As Workbook
Dim LastCol As Long
Dim LastRow As Long
Set wb = ActiveWorkbook
For Each ws In ActiveWorkbook.Worksheets
'Filter out the sheets that we don't want to run
If ws.Range("a9").Value <> "x" Or ws.Name = "__FDSCACHE__" Or ws.Name = "INDEX" Then
'Get the anchor points for getting sort range and the sort keys
''''''THIS IS THE PART THAT IS NOW GIVING ME THE ERROR'''''''
With ws.Range("a1:t100")
intAnchorRow = .Find(what:="sector", LookIn:=xlValues).Row
intSectorAnchor = .Find(what:="sector", LookIn:=xlValues).Column
intMktCapAnchor = .Find(what:="Market Cap", LookIn:=xlValues).Column
End With
'Find the last row and column of the data range
LastCol = ws.Cells(20, ws.Columns.Count).End(xlToLeft).Column
LastRow = ws.Range("a15").End(xlDown).Row
Set SortRng = Range(Cells(intAnchorRow + 1, 1), Cells(LastRow, LastCol))
Range(SortRng).Sort key1:=Range(Cells(intAnchorRow + 1, intSectorAnchor), Cells(LastRow, intSectorAnchor)), _
order1:=xlAscending, key2:=Range(Cells(intAnchorRow + 1, intMktCapAnchor), Cells(LastRow, intMktCapAnchor)), _
order2:=xlDescending, Header:=xlNo
End If
Next
End Sub
Thanks again. This has been very helpful for me.
If I've understood your issue correctly, you don't want to use a worksheet with an x in cell A9.
If that's the case I would change the condition of the if statement to check if the cell does not contain the x. If this is true, it enters the rest of the code. If not, it goes to the next iteration.
Also, your NextIteration: doesn't do anything in the If statement.
Sub sort_sectors()
Dim i As Integer
Dim rng As Range
Dim SortRng As Range
Dim rng1 As Integer
Dim ws As Worksheet
Dim wb As Workbook
Dim LastCol As Long
Dim LastRow As Long
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
'This is marking several of the sheets of which I do not want to run the sub
If ws.Range("a9").Value <> "x" Then
'Reference point is rng1 to select the desired range
With Range("a1:t100")
rng1 = .Find(what:="sector", LookIn:=xlValues).Row
End With
'return the row number for the sector header
LastCol = ws.Cells(20, ws.Columns.Count).End(xlToLeft).Column
LastRow = ws.Range("a15").End(xlDown).Row
'I am going to add the code below to finish out the task that I want to complete
End If
Next
End Sub
The : operator is used to return the code to that line after a goto call.
For example
sub gotoEx()
for i = 1 to 10
if i = 5 then
goto jumpToHere
end if
next i
jumpToHere: '<~~ the code will come here when i = 5
'do some more code
end sub
And of course you can use this structure in your code if you wish, and have the jumpToHere: line just before the next
e.g.
for each ws in wb.Worksheets
if ws.Range("a9").Value = "x" then
goto jumpToHere
end if
'the rest of your code goes here
jumpToHere:
next