Here is an image, followed by description of data
Description of Columns:
Column A (Key) is strictly increasing sequence of decimals
Column B (Group) represents a group the value in A belongs to.
Column C (Data) is assorted data
Inputs (in column F)
Exact Group number in i.e. {1, 2, 3, 4} in F4
A decimal value (unrestricted), call it DecimalValue, in F5
Task
Find row that belongs to the given Group, where ABS(Key - DecimalValue) value is minimized. Return Data from that row.
Ideally looking for an Excel-only solution, using INDEX, VLOOKUP,
ABS, and the like.
This question is similar to my previous question, but different enough (involves a new Groupcolumn), where via comments it was determined that it is best to ask a new question, rather than try to update / modify the existing question:
Display Row Values based on Nearest Numeric Match of Key
Adding correction for Group column, if it is possible is what I am after, hence the title reflects that concern.
(Incomplete Solution - does not consider Group column)
=INDEX(C4:C33,MATCH(MIN(ABS(A4:A33-F5)),ABS(A4:A33-F5),0))
Give this a go...it seems to work on my test sheet. Be sure to adjust the ranges to suit your situation. Again, this is an array formula and needs to be confirmed with Ctrl+Shift+Enter:
=INDEX(C2:C7,MATCH(MIN(ABS((B2:B7=F4)*A2:A7-F5)),ABS((B2:B7=F4)*A2:A7-F5),0),0)
It works by zeroing out keys that don't match your group assignment (that's the (B2:B7=F4)*A2:A7-F5) part. So only keys w/ valid groups have some number to be used to match to the data column.
Hope that helps explain it. You can also utilize the "Evaluate Formula" function on the Formulas toolbar to see it in action.
Note - it seems to return the 1st data value if 0 is used as the closest value (regardless of group selection). Not sure how to get around that...
Here is sous2817's answer adjusted to avoid the problem of getting the wrong result when entering 0:
=INDEX(Data,MATCH(MIN(IFERROR(ABS(IF(GroupNo=Group,1," ")*Key-DecimalValue),
" ")),IFERROR(ABS(IF(GroupNo=Group,1," ")*Key-DecimalValue)," "),0))
The explanation for how it works is the same. The problem is avoided by replacing zeroes with errors.
Note that Key is the key column, GroupNo is the Group number column, Data is the data column, Group is the designated group for searching, and DecimalNumber is the number entered for searching.
EDIT: As discussed in comments below, this formula can be made much more readable by using a named range (AKA named formula). Set a named range searchRange equal to:
IFERROR(ABS(IF(GroupNo=Group,1," ")*Key-DecimalValue)," ")
Then the formula becomes:
=INDEX(Data,MATCH(MIN(searchRange),searchRange,0))
This has the added benefit of less Excel overhead, since the named formula only gets calculated once (whereas in the other version, it is calculated every time it appears).
You should be able to do as follows
Function getLastRow()
Dim i As Integer
Dim l_row As Integer
For i = 1 To 35
If Sheet1.Cells(Rows.Count, i).End(xlUp).Row > l_row Then
l_row = Sheet1.Cells(Rows.Count, i).End(xlUp).Row
End If
Next i
getLastRow = l_row
End Function
Sub data_lookup
Dim last_row As Integer
Dim lcell as Range
Dim col_a_lookup As Double
Dim col_b_lookup AS Double
Dim row_collection As New Collection
Dim variance AS Double
Dim closest_row AS Integer
col_b_lookup = 0.04
col_a_lookup = 8
variance = 50
last_row = getLastRow
'Find All the Cells that match your lookup value for column B
For Each lcell in Sheet1.Range("$B$2", "$B$" & last_row)
If lcell.value = col_b_lookup Then
row_collection.Add lcell
End If
Next lcell
'Loop through the collection created above to find the closest absolute value to
'your lookup value for Column A
For Each lcell in row_collection
If Abs(Sheet1.Cells(lcell.row,"A") - col_a_lookup) < variance then
variance = Abs(Sheet1.Cells(lcell.row,"A") - col_a_lookup)
closest_row = lcell.row
End If
Next lcell
'Return Results
If closest_row > 0 Then
Msgbox "Closest Data: " & Sheet1.Cells(closest_row,"G")
Else
Msgbox "Cannot Locate"
End If
End Sub
Obviously you will have to set col_a_lookup and col_b_lookup to the values specified and I am sure you want to change the Msgbox. But this should help you on your way.
Related
Am trying to make a VBA validation sheet on Excel to find all the cells that do not match a predefined pattern and copy it to another sheet
My pattern is "4 numbers/5 numbers"
Ex: 1234/12345 is accepted
2062/67943 is accepted
372/13333 is not accepted
1234/1234 is not accepted etc...
I tried to put the following in the conditions sheet : <>****/***** and <>????/????? and both did not work (am not sure about the correctness of the approach as am still a beginner in VBA)
For the code itself, this is what I wrote :
Sub GuaranteeElig()
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = SheetName
Sheets("MainSheet").UsedRange.AdvancedFilter Action:= _
xlFilterCopy,
CriteriaRange:=Sheets("ConditionsSheet").Range("B1:B2"), _
CopyToRange:=Range("A1"), Unique:=False
End Sub
Any tips on how I can do it ?
Thanks in advance :)
As long as the values of the numbers are independent and do not matter, and it is only the Length of the numerical strings that count, you could use a for loop on the cells from the "search" sheet (I assume this is the MainSheet as shown in your code?) where your values are contained.
From there, I'll give you a couple ways to place the data in the validation sheet (assuming this is your ConditionsSheet as shown in your code?) where you are trying to pinpoint the values.
(You may need to change part of your approach depending on how you want the incorrect set of values laid out on your secondary sheet - but this should get you started.) I added a TON of comments as you say you're new to VBA - these will help you understand what is being done.
Sub GuaranteeElig()
'Adding this to help with performance:
Application.ScreenUpdating = False
'Assuming you are adding a sheet here to work with your found criteria.
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "ConditionsSheet"
'Using the naming bits below I am assuming the data you are searching for is on MainSheet
'Get used range (most accurate and efficient way I have found yet, others on S.O.
'may have better ways for this - research it if this does not work for you)
'I have had problems using the Sheets().UsedRange method.
Dim c as Long 'This may not be necessary for you if you are looping through only column "A"
Dim r as Long
'Cells(y,x) method uses numerical values for each row (y) or column (x).
c = Cells(1, Columns.Count).End(xlToLeft).Column 'May not be necessary depending on your needs.
'Using this because you have "UsedRange" in your
'code.
'.End(xlToLeft) signifies we are going to the end of the available cell range of
'Row 1 and then performing a "Ctrl+Left Arrow" to skip all blank cells until we hit
'the first non-blank cell.
r = Cells(Rows.Count, 1).End(xlUp).Row
'.End(xlUp) method is similar - we go to the end of the available cell range for the
'column ("A" in this case), then performing a "Ctrl+Up Arrow" to skip all blank cells.
'If you have a header row which spans across the sheet, this is your best option,
'unless you have 'helper' cells which extend beyond the final column of this header
'row. I am assuming Row 1 is a header in this case - change to your needs.
'For your Rows - choose the column which contains congruent data to the bottom of
'your used range - I will assume column 1 in this case - change to suit your needs.
Dim i as long
Dim j as integer
Dim cel as Range
Dim working_Str() as String 'String Array to use later
Dim string1 as String
Dim string2 as String
Dim badString as Boolean
For i = 2 to r Step 1 'Step down from row 2 to the end of data 1 Row at a time
'Row 1 is header.
set cel=Cells(i, 1) 'Sets the cell to check - assuming data is in Column "A"
'i will change from for loop so 'cel' changes from "A2555"
'to "A2554" to "A2553" etc.
working_Str=Split(cel.Value, "/", -1) 'Splits the value based on "/" inside of cel
string1=working_Str(0) 'what we hope will always be 4 digits
string2=working_Str(1) 'what we hope will always be 5 digits
If Len(string1)<>4 Then 'string1 _(xxxx)_(/)(don't care) does not equal 4 digits in length
badString = True
Elseif Len(string2)<>5 Then ''string1 (don't care)(/)_(xxxxx)_ does not equal 5 digits in length
badString = True
End If
If badString Then 'If either strings above were not correct length, then
'We will copy cell value over to the new sheet "ConditionsSheet"
'Comment the next 2 commands to change from going to one row at a time to
'Matching same row/Cell on the 2nd sheet. Change to suit your needs.
j = j + 1 'Counter to move through the cells as you go, only moving one cell
'at a time as you find incorrect values.
Sheets("ConditionsSheet").Range("A" & j).Value=cel.Value 'sets the value on other sheet
'UNComment the next command to change from going to one row at a time to
'matching same row/cell on the 2nd sheet. Change to suit your needs.
'Sheets("ConditionsSheet").Range("A" & i).Value=cel.Value
End if
badString = False 'resets your boolean so it will not fail next check if strings are correct
Next i
'Returning ScreenUpdating back to True to prevent Excel from suppressing screen updates
Application.ScreenUpdating = True
End Sub
UPDATE
Check the beginning and ending lines I just added into the subroutine. Application.ScreenUpdating will suppress or show the changes as they happen - suppressing them makes it go MUCH quicker. You also do not want to leave this setting disabled, as it will prevent Excel from showing updates as you try to work in the cell (like editing cell values, scrolling etc. . . Learned the hard way. . .)
Also, if you have a lot of records in the given row, you could try putting the data into an array first. There is a great example here at this StackOverflow Article.
Accessing the values of a range across multiple rows takes a LOT of bandwidth, so porting the range into an Array first will make this go much quicker, but it still may take a bit. Additionally, how you access the array information will be a little different, but it'll make sense as you research it a little more.
Alternative To VBA
If you want to try using a formula instead, you can use this - just modify for the range you are looking to search. This will potentially take longer depending on processing speed. I am entering the formula on 'Sheet2' and accessing 'Sheet1'
=IF(COUNTIF(Sheet1!A1,"????/?????"),1,0)
You are spot on with the search pattern you want to use, you just need to use a function which uses wildcard characters within an "if" function. What you do with the "If value is true" vs "If value is false" bits are up to you. COUNTIF will parse wildcards, so if it is able to "count" the cell matching this string combination, it will result in a "True" value for your if statement.
Regex method, this will dump the mismatched value in a worksheet named Result, change the input range and worksheet name accordingly.
In my testing, 72k cells in UsedRange takes about 4seconds~:
Option Explicit
Sub GuaranteeElig()
Const outputSheetName As String = "Result"
Dim testValues As Variant
testValues = ThisWorkbook.Worksheets("MainSheet").UsedRange.Value 'Input Range, change accordingly
Const numPattern As String = "[\d]{4}\/[\d]{5}"
Dim regex As Object
Set regex = CreateObject("VBScript.Regexp")
regex.Pattern = numPattern
Dim i As Long
Dim n As Long
Dim failValues As Collection
Set failValues = New Collection
'Loop through all the values and test if it fits the regex pattern - 4 digits + / + 5 digits
'Add the value to failValues collection if it fails the test.
For i = LBound(testValues, 1) To UBound(testValues, 1)
For n = LBound(testValues, 2) To UBound(testValues, 2)
If Not regex.Test(testValues(i, n)) Then failValues.Add testValues(i, n)
Next n
Next i
Erase testValues
Set regex = Nothing
If failValues.Count <> 0 Then
'If there are mismatched value(s) found
'Tranfer the values to an array for easy output later
Dim outputArr() As String
ReDim outputArr(1 To failValues.Count, 1 To 1) As String
For i = 1 To failValues.Count
outputArr(i, 1) = failValues(i)
Next i
'Test if output worksheet exist
Dim outputWS As Worksheet
On Error Resume Next
Set outputWS = ThisWorkbook.Worksheets(outputSheetName)
On Error GoTo 0
'If output worksheet doesn't exist, create a new sheet else clear the first column for array dump
If outputWS Is Nothing Then
Set outputWS = ThisWorkbook.Worksheets.Add
outputWS.Name = outputSheetName
Else
outputWS.Columns(1).Clear
End If
'Dump the array starting from cell A1
outputWS.Cells(1, 1).Resize(UBound(outputArr, 1)).Value = outputArr
Else
MsgBox "No mismatched value found in range"
End If
Set failValues = Nothing
End Sub
If you do not need duplicate values in the list of mismatched (i.e. unique values) then sound out in the comment.
I overlooked an obvious case scenario while writing the following, and am hoping the experts here can shed light on what path I should go down next to recover this code...
If Application.counta(wurgtbl.DataBodyRange.Columns(7)) > 0 Then 'checks if Note column contains any
wurgtbl.DataBodyRange.AutoFilter Field:=7, Criteria1:="=*" 'uses autofilter to show only rows with a note
Dim noterange As Range 'store note row addresses in range, each row (was supposed to) be treated as separate area
Set noterange = wurgtbl.DataBodyRange.SpecialCells(xlCellTypeVisible)
'oops, this only works if 100% discontinuous (multiple selection) ranges. when any contiguous rows have a note,
'their ranges are treated as a single selection which breaks my assumption of each row being a separate area!
'I had initially spaced my test notes out on different rows and it only broke when testing two contiguous notes
'add range to array: since discontinuous range is certain, cant mainnotes = noterange.Value, must loop instead
Dim mainnotes() As String
ReDim mainnotes(0 To 6, 0 To noterange.Areas.Count - 1)
Dim area As Range 'each group (area) will get its own row in array
Dim acell As Range 'this will be each actual cell in the sub-groups
Dim areaNum As Long
areaNum = 0
For Each area In noterange.Areas
i = 0
For Each acell In area
mainnotes(i, areaNum) = acell.Value
i = i + 1
Next acell
areaNum = areaNum + 1
Next
End If
From Microsoft documentation:
For a single selection, the Areas property returns a collection that contains one object—the original Range object itself.
For a multiple-area selection, the Areas property returns a collection that contains one object for each selected area.
Therein is the problem: I assumed Areas property would always return each row as an Area object, but in hindsight it makes sense that it would join the Areas by default if they are contiguous ranges.
The overall goal is to store any notes the user placed in a column before refreshing the workbook data. Once refreshed, it loops through the array and places the notes back into matching entries. I was using hidden helper worksheets (to store) previously but wanted to use arrays instead for all the obvious benefits. My initial assumption of only non-contiguous note rows was admittedly a terrible assumption in hindsight. While the workbook will absolutely have non-contiguous notes, it could also have them contiguous, and will most likely contain both, making noterange return a combination of areas where some areas are individual rows as I want them, but other areas are contiguous rows that need to be split somehow to work with my design.
So is it possible to take a contiguous range and then split it into component rows?
For example, the range object noterange.Address returns contiguous:
$A$4:$G$6
But I assumed it would return as a collection (before reading the documentation for Range.Areas)
$A$4:$G$4,$A$5:$G$5,$A$6:$G$6
containing N = 3 areas. (just as an example, in practice N is ~ 140K rows that might potentially contain a value in the note column.)
To be clear, the actual VBA error occurs here mainnotes(i, areaNum) = acell.Value because if an Area contains more than one row, the number of cells (or i) then exceeds the bounds of the array definition. Everything works great if there are no contiguous rows, where it then treats each row as a separate area.
In typing this out, hopefully my subconscious begins to solve it. But I feel I've reached my limit of knowledge on this and would appreciate being steered in the right direction!
Huge credit to BigBen for providing the necessary clues in his comments and introducing me to .CountLarge in an Answer he subsequently deleted.
I implemented most of his suggestions (though column# still hard-coded):
Dimensioned the array using standard practice of rows/columns instead of the reverse.
Dimensioned the array using noterange.Cells.CountLarge / (# of columns) to get actual number of rows that will exist, rather than using the number of Areas (because some areas will contain more than one row in this scenario.)
Iterated through each Range.Area, then each Row within that Range.Area, then through each Cell within that Row, assigning the Range.Value to it's position within the array.
Here is the final code which works no matter what the configuration of the Notes are in the note column:
'check if notes exist in note column
If Application.counta(wurgtbl.DataBodyRange.Columns(7)) > 0 Then
'use autofilter to show only rows with a note
wurgtbl.DataBodyRange.AutoFilter Field:=7, Criteria1:="=*"
'store visible addresses in range
Dim noterange As Range
Set noterange = wurgtbl.DataBodyRange.SpecialCells(xlCellTypeVisible)
'add range to array: since discontinuous range is certain, cant mainnotes = noterange.Value, must loop instead
Dim mainnotes() As String
ReDim mainnotes(0 To noterange.Cells.CountLarge / 7 - 1, 0 To 6) 'Credit to BigBen on SO for this (rows/columns)
Dim areaiterate As Long
Dim rowNumb As Long
Dim colNumb as Long
Dim arow As Range
Dim rcell As Range
rowNumb = 0
For areaiterate = 1 To noterange.Areas.Count
For Each arow In noterange.Areas(areaiterate).Rows
colNumb = 0
For Each rcell In arow.Cells
mainnotes(rowNumb, colNumb) = rcell.Value
colNumb = colNumb + 1
Next
rowNumb = rowNumb + 1
Next arow
Next areaiterate
End If
Thank you to BigBen for the suggestions and snippet!
Currently I have a medical spread-sheet with a list of clients that we have serviced. We have 8 different clinical categories which are denoted by different acronyms - HV,SV,CV,WV,CC,OV,TS and GS.
A client can receive multiple therapies i.e. HV,SV,CV - in the background we have a counter mechanism which would increment each of these records by 1.The formula used for this counter is:
=(LEN('Parent Sheet'!F25)-LEN(SUBSTITUTE('Parent Sheet'!F25,'Parent Sheet'!$P$4,"")))/LEN('Parent Sheet'!$P$4)
At the bottom of the sheet we then have a sum which ads up all the treatments that occurred for that week.
Now the tricky part about this is that we have almost a year's worth of data in this sheet but the summing formulas are set as: SUM(COLUMN 6: COLUMN 53) but due to a need to increase the entries beyond this limit, we have to adjust the sum formula. We have 300 SUM Formulas adding up each of the 8 Criteria items and assigning them to the HV,SV,SC,WV etc. counters.
Would we have to adjust this manually one by one or is there a easier way of doing this?
Thank you very much!
To me, I think you should change the sheet layout a little, create a User Defined Function (UDF) and alter the formulas in your Sum rows for efficient row/column adding (to make use of Excel's formula fill). The only issue is that you need to save this as a Macro-Enabled file.
What you need to change in the formulas is to utilize $ to restrict changes in column and rows when the formula fill takes place.
To illustrate in an example, consider:
Assuming the first data starts at row 6, and no more than row 15 (you can use the idea of another data gap on the top). Alter the Sum row titles to begin with the abbreviation then create a UDF like below:
Option Explicit
' The oRngType refers to a cell where the abbreviation is stored
' The oRngCount refers to cells that the abbreviation is to be counted
' Say "HV" is stored in $C16, and the cells to count for HV is D$6:D$15,
' then the sum of HV for that date (D16) is calculated by formula
' `=CountType($C16, D$6:D$15)`
Function CountType(ByRef oRngType As Range, ByRef oRngCount) As Long
Dim oRngVal As Variant, oVal As Variant, oTmp As Variant, sLookFor As String, count As Long
sLookFor = Left(oRngType.Value, 2)
oRngVal = oRngCount.Value ' Load all the values onto memory
count = 0
For Each oVal In oRngVal
If Not IsEmpty(oVal) Then
For Each oTmp In Split(oVal, ",")
If InStr(1, oTmp, sLookFor, vbTextCompare) > 0 Then count = count + 1
Next
End If
Next
CountType = count
End Function
Formulas in the sheet:
Columns to sum are fixed to rows 6 to 15 and Type to lookup is fixed to Column C
D16 | =CountType($C16,D$6:D$15)
D17 | =CountType($C17,D$6:D$15)
...
E16 | =CountType($C16,E$6:E$15)
E17 | =CountType($C17,E$6:E$15)
The way I created the UDF is to lookup and count appearances of a cell value (first argument) within a range of cells (second argument). So you can use it to count a type of treatment for a big range of cells (column G).
Now if you add many columns after F, you just need to use the AutoFill and the appropriate rows and columns will be there.
You can also create another VBA Sub to add rows and columns and formulas for you, but that's a different question.
It's isn't a great idea to have 300 sum formulas.
Name your data range and include that inside the SUM formula. So each time the NAMED data range expands, the sum gets calculated based on that. Here's how to create a dynamic named rnage.
Sorry I just saw your comment. Following is a simple/crude VBA snippet.
Range("B3:F12") is rangeValue; Range("C18") is rngTotal.
Option Explicit
Sub SumAll()
Dim WS As Worksheet
Dim rngSum As Range
Dim rngData As Range
Dim rowCount As Integer
Dim colCount As Integer
Dim i As Integer
Dim varSum As Variant
'assuming that your said mechanism increases the data range by 1 row
Set WS = ThisWorkbook.Sheets("Sheet2")
Set rngData = WS.Range("valueRange")
Set rngSum = WS.Range("rngTotal")
colCount = rngData.Columns.Count
'to take the newly added row (by your internal mechanism) into consideration
rowCount = rngData.Rows.Count + 1
ReDim varSum(0 To colCount)
For i = 0 To UBound(varSum, 1)
varSum(i) = Application.Sum(rngData.Resize(rowCount, 1).Offset(, i))
Next i
'transpose variant array with totals to sheet range
rngSum.Resize(colCount, 1).Value = Application.Transpose(varSum)
'release objects in the memory
Set rngSum = Nothing
Set rngData = Nothing
Set WS = Nothing
Set varSum = Nothing
End Sub
Screen:
You can use named ranges as suggested by bonCodigo or you could use find and replace or you can insert the columns within the data range and Excel will update the formula for you automatically.
I have an Excel file where data is kept for monthly expenses with supply orders for co-workers. If a co-worker needs a Head set let's say, it is put into an Excel sheet with a dollar amount of how much it costs. I want to make it automated so if you enter Head set in one cell the dollar amount automatically comes up in the "Total Cost" cell. The problem being that there are multiple items that can be ordered.
I've come up with what I think could be a start but not sure how to implement it. I'm looking for guidance and any suggestions on what to do here.
Column M contains the "supply input" such as Head set, lumbar support, etc.
Column K contains the "total cost".
IF (M16 = Foot Rest, "$20.48","-")
However Column M could also contain Foot Rest, and Head set so that's what's tripping me up. I would like to think that it would contain an extended ELSEIF statement on the above IF statement but I'm unsure how that would work.
I don't have enough rep to leave a comment, but:
As mentioned, a VLOOKUP as Gareth suggested is your best bet - you would have to build a table of items and prices, and use
VLOOKUP(value to lookup(Foot rest in this case),
table to look in (you will usually want to make this static ($A$1:$B$2),
column to RETURN value from (2 in this case),
and match type (typically you use false/0 for an exact match).
Also note, vlookup only tries to match the leftmost column of your array (you will need to use index/match if you want to lookup in another column) - so you find the value in the leftmost column, and return the corresponding value in the (arguement 3)rd column..
(it won't let me post an image): http://i.stack.imgur.com/uHwwH.png
To answer your question about ELSEIF, you have to nest IFs, so it gets ugly really fast (tip, you can use alt-enter to do a return in the formula):
> IF(check1,
true_result,
IF(check2,false_result1,false_result2)
)
So, in your case, IF (M16 = Foot Rest, "$20.48", IF(M16="Headset",12,"-"))
One way for the user to select options is to put your items in a listbox. This may help with the management/separation/unintentional corruption of your list data and help prevent mistyping by users. This is an illustrative example only of how you might set-up a (ActiveX) listbox directly on a worksheet. Some research may also show you additional flexibilities e.g. multi-columns, multi-select of items, pop-out userforms etc.
Option Explicit
Private Sub slctLbox()
Dim ws As Worksheet
Dim drng As Range
Dim lBox As MSForms.ListBox
Dim dstrow As Long, dendrow As Long, dstcol As Long, dendcol As Long
Dim lstArr() As Variant
Set ws = Sheets("Sheet1")
'location of data
dstcol = 13 'col M
dstrow = 1 'row 1
'determine data range
With ws
dendcol = .Cells(dstrow, Columns.Count).End(xlToLeft).Column
dendrow = .Cells(Rows.Count, dstcol).End(xlUp).Row
Set drng = .Range(.Cells(dstrow, dstcol), .Cells(dendrow, dendcol))
End With
Set lBox = Sheets("Sheet1").ListBox1
'put data into an array
lstArr = drng
'setup listbox
With lBox
.Clear
.ColumnHeads = False
.ColumnCount = 1
.ColumnWidths = "50"
'put data array into listbox
.List = lstArr
.TopIndex = 0
End With
End Sub
I would like to do a vertical lookup for a list of lookup values and then have multiple values returned into columns for each lookup value. I actually managed to do this after a long Google search, this is the code:
=INDEX(Data!$H$3:$H$70000, SMALL(IF($B3=Data!$J$3:$J$70000, ROW(Data!$J$3:$J$70000)-MIN(ROW(Data!$J$3:$J$70000))+1, ""), COLUMN(A$2)))
Now, my problem is, as you can see in the formula, my lookup range contains 70,000 rows, which means a lot of return values. But most of these return values are double. This means I have to drag above formula over many columns until all lookup values (roughly 200) return #NUM!.
Is there any possible way, I guess VBA is necessary, to return the values after duplicates have been removed? I'm new at VBA and I am not sure how to go about this. Also it takes forever to calculate having so many cells.
[Edited]
You can do what you want with a revised formula, not sure how efficient it will be with 70,000 rows, though.
Use this formula for the first match
=IFERROR(INDEX(Data!$H3:$H70000,MATCH($B3,Data!$J3:$J70000,0)),"")
Now assuming that formula in in F5 use this formula in G5 confirmed with CTRL+SHIFT+ENTER and copied across
=IFERROR(INDEX(Data!$H3:$H70000,MATCH(1,($B3=Data!$J3:$J70000)*ISNA(MATCH(Data!$H3:$H70000,$F5:F5,0)),0)),"")
changed the bolded part depending on location of formula 1
This will give you a list without repeats.....and when you run out of values you get blanks rather than an error
Not sure if you're still after a VBA answer but this should do the job - takes about 25 seconds to run on my machine - it could probably be accelerated by the guys on this forum:
Sub ReturnValues()
Dim rnSearch As Range, rnLookup As Range, rnTemp As Range Dim varArray
As Variant Dim lnIndex As Long Dim strTemp As String
Set rnSearch = Sheet1.Range("A1:A200") 'Set this to your 200 row value range
Set rnLookup = Sheet2.Range("A1:B70000") 'Set this to your lookup range (assume 2
columns)
varArray = rnLookup
For Each rnTemp In rnSearch
For lnIndex = LBound(varArray, 1) To UBound(varArray, 1)
strTemp = rnTemp.Value
If varArray(lnIndex, 1) = strTemp Then
If WorksheetFunction.CountIf(rnTemp.EntireRow, varArray(lnIndex, 2)) = 0 Then 'Check if value exists already
Sheet1.Cells(rnTemp.Row, rnTemp.EntireRow.Columns.Count).End(xlToLeft).Offset(0, 1).Value =
varArray(lnIndex, 2)
End If
End If
Next Next
End Sub