I have a workbook, I need to populate the result in every rows in my Sheet1, C13:c31 and cell H13:H31 by using vlookup. The lookup value is in Sheet1, cell B13:B31. My table array is in Sheet4. I need to get result in Sheet4, column C & D and display the result in Sheet 1, cell c13:c31 and cell H13:h31. (I don't want to display the formula, that is why I want to used VBA instead.
Please check my code below, because it is not working.
Sub Vlookup()
Dim c As Range
Dim d As Range
If Sheet1.Range("B13").Value = "*" Then
c = Application.WorksheetFunction.Vlookup(Sheet1.Range("B13").Value, Sheet4.Range("A:E"), 3, False)
d = Application.WorksheetFunction.Vlookup(Sheet1.Range("B13").Value, Sheet4.Range("A:E"), 4, False)
End If
If Sheet1.Range("B14").Value = "*" Then
c = Application.WorksheetFunction.Vlookup(Sheet1.Range("B13").Value, Sheet4.Range("A:E"), 3, False)
d = Application.WorksheetFunction.Vlookup(Sheet1.Range("B13").Value, Sheet4.Range("A:E"), 4, False)
End If
If Sheet1.Range("B15").Value = "*" Then
c = Application.WorksheetFunction.Vlookup(Sheet1.Range("B13").Value, Sheet4.Range("A:E"), 3, False)
d = Application.WorksheetFunction.Vlookup(Sheet1.Range("B13").Value, Sheet4.Range("A:E"), 4, False)
End If
End Sub
This should give you some idea of how it can be done:
Sub Vlookup()
Dim c As Range, v, r1, r2, rngSearch As Range
Set rngSearch = Sheet4.Range("A:E")
For Each c In Sheet1.Range("B13:C31").Cells 'loop the input range
v = c.Value
If Len(v) > 0 Then 'is there anything to look up?
'drop the `WorksheetFunction` to prevent run-time
' error if there's no match
v1 = Application.Vlookup(v, rngSearch, 3, False)
v2 = Application.Vlookup(v, rngSearch, 4, False)
'IsError(vx) will be True if no match was found
c.EntireRow.Columns("C").Value = IIf(IsError(v1), "-", v1) ' "-" if no match
c.EntireRow.Columns("C").Value = IIf(IsError(v2), "-", v1)
End If
Next c
End Sub
Could be a problem with the if statements.
You can try If IsEmpty(Range("B13").Value) = False Then instead of the wildcard "*".
Related
I have written the below function which basically VLOOKUPs all the results associated with the value being VLOOKUPd and stacks them in a list.
For example
A 1
A 2
A 3
A 4
A 5
A 6
B 7
B 8
B 9
B 0
if we VLOOKUP on value A the result should be 1, 2, 3, 4, 5, 6
A 1 1, 2, 3, 4, 5, 6
A 2 1, 2, 3, 4, 5, 6
A 3 1, 2, 3, 4, 5, 6
A 4 1, 2, 3, 4, 5, 6
A 5 1, 2, 3, 4, 5, 6
A 6 1, 2, 3, 4, 5, 6
B 7 N/A
B 8 N/A
B 9 N/A
B 0 N/A
But the function takes too much time to run on more than 50 rows of data, is there a way to make it run faster and hopefully not crash the Excel file?
Function MYVLOOKUP(lookupval, lookuprange As Range, indexcol As Long)
Dim r As Range
Dim result As String
result = ""
For Each r In lookuprange
If r = lookupval Then
If result = "" Then
result = result & " " & r.Offset(0, indexcol - 1)
Else
result = result & ", " & r.Offset(0, indexcol - 1)
End If
End If
Next r
MYVLOOKUP = result
End Function
You could consider using the Find() method of the Range object like so:
Function MYVLOOKUP(lookupval, lookuprange As Range, indexcol As Long) As String
Dim foundRange As Range
Dim foundArr() As String: ReDim foundArr(0 To 0)
Dim firstFoundAddress As String
'perform the first find
Set foundRange = lookuprange.Find(lookupval)
'Capture address to avoid looping
firstFoundAddress = foundRange.Address
'Find values
Do While Not foundRange Is Nothing
'Bump the array if this isn't the first element
If foundArr(0) <> "" Then ReDim Preserve foundArr(0 To UBound(foundArr) + 1)
'Add to the array
foundArr(UBound(foundArr)) = foundRange.Offset(, indexcol - 1).Value
'Lookup next value
Set foundRange = lookuprange.Find(What:=lookupval, After:=foundRange)
'Exit if we looped
If foundRange.Address = firstFoundAddress Then Exit Do
Loop
'join the results for output
MYVLOOKUP = Join(foundArr, ",")
End Function
Find() is very quick to run and you won't have to iterate your entire search range.
#JNevill just beat me to it, but wanted to post my code anyway. :)
This will work for a sorted list and return #N/A if lookupval isn't found.
Public Function MyVlookup(lookupval As Variant, lookuprange As Range, indexcol As Long) As Variant
Dim rFound As Range
Dim itmCount As Long
Dim rReturns As Variant
Dim itm As Variant
Dim sReturn As String
With lookuprange
'After looks at the last cell in first column,
'so first searched cell is first cell in column.
Set rFound = .Columns(1).Find( _
What:=lookupval, _
After:=.Columns(1).Cells(.Columns(1).Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchDirection:=xlNext, _
MatchCase:=True)
If Not rFound Is Nothing Then
itmCount = Application.WorksheetFunction.CountIf(lookuprange, lookupval)
rReturns = rFound.Offset(, indexcol - 1).Resize(itmCount)
For Each itm In rReturns
sReturn = sReturn & itm & ","
Next itm
MyVlookup = Left(sReturn, Len(sReturn) - 1)
Else
MyVlookup = CVErr(xlErrNA)
End If
End With
End Function
Edit - almost works. =MyVlookup("A",$A6:$B$10,2) on the sample data returns #VALUE rather than 6.
You haven't provided any information on how the UDF is deployed but I'll bet that is at least half of the problem.
I'm betting you are recreating that concatenated string for every duplicate in column A. Further, I reckon there is a pretty good chance you are using full column references.
I'm going to assume that your data starts in row 2.
The extent of the numbers in column B is,
b2:index(b:b, match(1e99, b:b))
The extent of the duplicated identifiers in column A is,
a2:index(a:a, match(1e99, b:b))
If you have already concatenated a result for the identifier in column A then it is a lot faster to retrieve that result from above then it is to build it again. Further, if you are looking above the current row to see if a result has already been processed and it hasn't been processed then there is no reason to include those rows in the current concatenation build.
In C2 use this formula and fill down to the extent of the values in columns A & B.
=iferror(index(c$1:C1, match(a2, a$1:a1, 0)), MYVLOOKUP(a2, a$1:index(b:b, match(1e99, b:b)), 2))
If your data actually starts in row 1then usethis formula in C1.
=MYVLOOKUP(a2, a$1:index(b:b, match(1e99, b:b)), 2)
Example:
Consider the above formula in C10. It looks for a match to A10 within A1:A9; if found, it returns the previously concatenated string from the associated row in column C. If not found, it builds a new concatenated string but only from the identifiers starting in row 10 from column A and the values starting with row 10 in column B down to the row containing the last number in column B.
I am trying to write a similar function in VBA:
=VLOOKUP(“EN878”,CHOOSE({1,2},A2:B5,D2:E5),2,False)
In particular, What is the correct way of using the {} character in VBA?
Every time I try, I get "Compile error: Invalid Character"
My code:
Variables
Table3 = Workbooks("gangstar.xlsx").Worksheets("60 in August 2016-26082016-1137").Range("A1:A1000")
Table2 = Workbooks("gangstar.xlsx").Worksheets("60 in August 2016-26082016-1137").Range("H1:H1000")
For Each cl In Table1
Sheet1.Cells(Dept_Row, Dept_Clm) = Application.WorksheetFunction.VLookup(cl, Choose({1,2}, Table2, Table3), 2, False)
Dept_Row = Dept_Row + 1
Next cl
I am able to use the VLOOKUP with CHOOSE fine in the Excel spreadsheet.
Try the following, which doesn't require modification or recalculation of any cells on the Worksheet:
WorksheetFunction.VLookup("EN878", WorksheetFunction.Choose(Array(1, 2), Range("A2:B5"), Range("D2:E5")), 2, False)
If you are trying to decide which table to use as Vlookup array you can use IIf function.
Like:
Application.WorksheetFunction.VLookup(cl, IIf(cl.column=1, Table2, Table3), 2, False)
I would recommend using Sheet1.Cells(myRow, myCol).Formula = "=VLOOKUP(...)" followed by Sheet1.Cells(myRow, myCol).Calculate.
Not an answer but what the OP is doing is not as simple as it appears.
Given this data:
And this code:
Sub Tester()
Dim r
r = Application.Evaluate("CHOOSE({1,2},A1:B5,E1:F5)")
Dumper r
End Sub
Sub Dumper(arr)
Dim r, c, s, v
For r = 1 To UBound(arr, 1)
s = ""
For c = 1 To UBound(arr, 2)
v = arr(r, c)
s = s & vbTab & IIf(IsError(v), "Err!", v)
Next c
Debug.Print s
Next r
End Sub
Here's the output:
A1 F1
A2 F2
A3 F3
A4 F4
A5 F5
Is that what you'd expect ?
I would use range.formulaR1C1 property.
Table3AddressR1C1 = Workbooks("gangstar.xlsx").Worksheets("60 in August 2016-26082016-1137").Range("A1:A1000").address(,,xlR1C1, true)
Table2AddressR1C1 = Workbooks("gangstar.xlsx").Worksheets("60 in August 2016-26082016-1137").Range("H1:H1000").address(,,xlR1C1, true)
Sheet1.Range(Cells(1, Dept_Clm), Cells(Table1.rows.count, Dept_Clm)).FormulaR1C1 = "=VLookup(RxCx, Choose({1,2}, Table2AddressR1C1, Table3AddressR1C1), 2, False)"
How do I extract a list of cell references from a string search found under the 1st column using VBA? For example, from the image attached below, how do I return a list of cell references of the string "Apple" from the 1st row? Preferably the list of the cell references should be listed under the 2nd column.
Data
Thank you in advance.
try this:
Option Compare Text 'to remove case sensitivity
Sub test()
Dim S1$, S2$, Fruits As Range, x As Range
Set Fruits = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each x In Fruits
If x.Value2 = "Apple" Then
S1 = S1 & " " & x.Address(0, 0)
ElseIf x.Value2 = "Kiwi" Then
S2 = S2 & " " & x.Address(0, 0)
End If
Next
S1 = Mid(S1, 2, Len(S1)): S2 = Mid(S2, 2, Len(S2))
Range([B2], Cells(UBound(Split(S1)) + 2, "B")) = Application.Transpose(Split(S1))
Range([C2], Cells(UBound(Split(S2)) + 2, "C")) = Application.Transpose(Split(S2))
End Sub
test:
I have 2 sets of data in two cells (A1 and B1) without any special character (.,/;:'"-##$%^&*(){}[]) and also no space between words,
The problem is I need to compare both the cells and identify and highlight the difference.
For example :
(A1): howtobuilfmacroincludingthesecrria
(B1): howbuilfmacroincludingthesecriteria
in A1 ite is missing
and B1 to is missing
The macro should highlight ite in B1 and to in A1
Make sure the text strings are in cells A1 and B1.
Place these routines in a standard code module (Alt-F11).
Run the FindDistinctSubstrings routine (Alt-F8 from the worksheet).
Public Sub FindDistinctSubstrings()
Dim a$, b$
a = [a1]
b = [b1]
S1inS2 0, 2, a, b, [a1], vbRed
S1inS2 0, 2, b, a, [b1], vbRed
S1inS2 1, 3, a, b, [a1], vbBlack
S1inS2 1, 3, b, a, [b1], vbBlack
End Sub
Private Sub S1inS2(yes&, k&, s1$, s2$, r As Range, color&)
Dim i&
For i = 1 To Len(s1)
If (yes = 0 And 0 = InStr(s2, Mid$(s1, i, k))) Or (yes = 1 And 0 < InStr(s2, Mid$(s1, i, k))) Then
r.Characters(i, k).Font.color = color
End If
Next
End Sub
it's very difficult to perform mutual checks because excel doesn't know the words. What does it words represent?
You can do check on one column like this:
Sub CompareMacro()
Dim columnA As Integer
Dim columnB As Integer
Dim NumberOfCaracters As Integer
Dim f As Integer
f = 1
For numbuerOfRows = 1 To 5
columnA = Len(Worksheets(1).Cells(numbuerOfRows, 1))
columnB = Len(Worksheets(1).Cells(numbuerOfRows, 2))
If columnA > columnB Then
NumberOfCharacters = columnA
Else
NumberOfCaracters = columnB
End If
Dim columnALetters(3) As Variant
For i = 1 To NumberOfCaracters
If Mid(Worksheets(1).Cells(numbuerOfRows, 1), i, 1) = Mid(Worksheets(1).Cells(numbuerOfRows, 2), f, 1) Then
f = f + 1
Else
Worksheets(1).Cells(numbuerOfRows, 1).Characters(i, 1).Font.Color = vbRed
End If
Next i
Next numbuerOfRows
End Sub
You can use object and then use msword concept first A1 content in one and other in second and compare two of them any n no.of words is there it shows and highlight.
I have a column A, that contains either one of the following values:
DATEnone
nonenone
noneTIME
DATETIME
I want to write a function that basically does this:
if A1 is "DATEnone" or A1 is DATETIME:
A1 = "D"
elif A1 is "noneTIME":
A1 = "T"
else:
A1 = "S"
how can I do that in an excel cell function?
Copy-Paste this code in a new module and hit F5 to run the macro.
Sub Main()
Application.ScreenUpdating = False
Dim c As Range
For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
If StrComp("DATEnone", c, 1) = 0 Or StrComp("DATETIME", c, 1) = 0 Then
c = "D"
ElseIf StrComp("noneTime", c, 1) = 0 Then
c = "T"
Else
c = "S"
End If
Next c
Application.ScreenUpdating = True
End Sub
This code iterates over column A and replaces the contents based on the conditions you specified.
And if you wanted just a function then stick this formula
=IF(OR(A1="DATEnone", A1="DATETIME"),"D", IF(A1="noneTime","T","S"))
in cell B1 and drag it down the B column