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
Related
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.
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 am trying to apply "=IFERROR" to a spreadsheet containing over 1000 rows of data. I already came up with a way to make the entries hard-coded. But is there a way to fill the cells with something like "=IFERROR(IFERROR(A1,B1),"")" rather than the value? Below is the hard-coded version:
Sub HardCodeIFERROR()
Dim a As Integer, xRecordCount1 As Integer
Set w(1) = Sheets("ABC")
xRecordCount1 = w(1).Cells(Rows.Count, 1).End(xlUp).Row
For a = 1 To xRecordCount1
w(1).Cells(a, 3).Value = Application.WorksheetFunction.IfError(Application.WorksheetFunction.IfError(Range("A" & a), Range("B" & a)), "")
Next a
Exit Sub
End Sub
Thank you in advance for your help!
You can instead just use .Formula:
w(1).Cells(a, 3).Formula = "=IFERROR(IFERROR(A" & a & ",B" & a & "),"""")"
Note you can skip the loop and just use a range:
Sub HardCodeIFERROR()
Dim ws1 As Worksheet
Dim a As Integer, xRecordCount1 As Integer
Set ws1 = Sheets("Sheet1")
xRecordCount1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
With ws1
.Range(.Cells(1, 3), .Cells(xRecordCount1, 3)).FormulaR1C1 = "=IFERROR(IFERROR(RC[-2],RC[-1]),"""")"
End With
End Sub
Note: Make sure to use the sheet with the Rows.Count whenever you use it, just like you do with Cells() and Range(). Also, I changed the sheet name because I wasn't sure if you intended to do a Sheet Array or not, so I used a more clear (IMO) variable name.
Just use the Formula property:
Sub HardCodeIFERROR()
Dim a As Integer, xRecordCount1 As Integer
'Need to declare the size of the array if you are going to assign worksheets to "w(1)"
Dim w(1 To 1) As Worksheet
Set w(1) = Sheets("ABC")
'Ensure you fully qualify "Rows.Count" by specifying which worksheet you are referring to
xRecordCount1 = w(1).Cells(w(1).Rows.Count, 1).End(xlUp).Row
'Apply formula to all cells
w(1).Range("C1:C" & xRecordCount1).Formula = "=IFERROR(IFERROR(S1,V1),"""")"
End Sub
I am trying to run a code that I found also here. the code is removing duplicates on each column on each spreed sheet on a workbook treating it as a separate entity. whenever I try to run the code the compiler error says "sub or function not defined" and there is a yellow highlight on the most upper part and the "LastCell" got a blue highlight. I already add the solver reference but still it gives me the same error. I just can't figure out what the problem is if it's on the code or should I add another reference.
Sub Removeduplicates()
Dim ws As Workbook
Dim lLastcol As Long
Dim lLastrow As Long
Dim i As Long
For Each ws In ThisWorkbook.Worksheets
lLastcol = LastCell(ws).Column
For i = 1 To lLastcol
lLastrow = LastCell(ws, i).Row
With ws
.Range(.Cells(1, i), .Cells(lLastrow, i)).Removeduplicates Columns:=1, Header:=xlNo
End With
Next i
Next ws
End Sub
Looks like lasy cell is the function you thought you had. We is the worksheet passed in. Thee function will use something like
Function lastcell(w as worksheet) as range
Set Lastcell=w.range("a" & w.rows.count).end(xlup)
End function
After deciphering your code snippet, this is the best that I can come up with.
Function lastCell(ws As Worksheet, _
Optional c As Variant, _
Optional r As Variant) As Range
With ws
If IsMissing(c) And IsMissing(r) Then
Set lastCell = .Cells.SpecialCells(xlCellTypeLastCell)
ElseIf IsMissing(c) And Not IsMissing(r) Then
Set lastCell = .Cells(r, .Columns.Count).End(xlToLeft)
ElseIf IsMissing(r) And Not IsMissing(c) Then
Set lastCell = .Cells(.Rows.Count, c).End(xlUp)
Else
Set lastCell = .Cells(r, c)
End If
End With
End Function
Copy that code to a module code sheet in your VBA project. It can tested with a short sub procedure like the following.
Sub test()
Dim ws1 As Worksheet
Set ws1 = ActiveSheet
Debug.Print lastCell(ws1).Address(0, 0) '<~~ last cell on worksheet
Debug.Print lastCell(ws1, 3).Address(0, 0) '<~~ last used cell in column C
Debug.Print lastCell(ws1, , 4).Address(0, 0) '<~~ last used column on row 4
End Sub
If you're referring to the solution of Darren Bartrup-Cook here, make sure to copy the function LastCell to your code as well.
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.