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've got a formula that's been puzzling me for a while - I feel I'm close but the solution is evading me so I'm turning to you wizards. This questions is similar to Excel VLOOKUP and SEARCH combination.
Problem:
I want to look up a value which is a pair of codes separated by a dash, ex.
01-05
A1-B2
AB-90
, within columns A and B and return a result from C.
The issue is that I'm searching in two columns, which may include multiple codes separated by commas:
Col A Col B Col C
01 05, B2 Result1
A1 B2 Result2
AB, AC 90, 91, 92 Result3
I was thinking that a =if(isnumber(search( function would be the key but I can't figure how to have it check the entire column and once found, check the column next to it for the 2nd part of the code.
Ideally, the formula would perform as such, where in the above example, if I were to run this formula on the criteria 01-05 it would return Result1.
Appreciated!
the "formula" approach is, to my knowledge, quite verbose and cumbersome as follows:
=IF(
ISNA(
IFERROR(MATCH(LEFT(D1,SEARCH("-",D1)-1),Codes!$A$1:$A$100,0),
IFERROR(MATCH("*"&LEFT(D1,SEARCH("-",D1)-1)&",*",Codes!$A$1:$A$100,0),
MATCH("*,"&LEFT(D1,SEARCH("-",D1)-1)&"*",Codes!$A$1:$A$100,0)))
*
IFERROR(MATCH(RIGHT(D1,LEN(D1)-SEARCH("-",D1)),Codes!$B$1:$B$100,0),
IFERROR(MATCH("*"&RIGHT(D1,LEN(D1)-SEARCH("-",D1))&",*",Codes!$B$1:$B$100,0),
MATCH("*,"&RIGHT(D1,LEN(D1)-SEARCH("-",D1))&"*",Codes!$B$1:$B$100,0)))
),
"Not Found",
IF(IFERROR(MATCH(LEFT(D1,SEARCH("-",D1)-1),Codes!$A$1:$A$100,0),
IFERROR(MATCH("*"&LEFT(D1,SEARCH("-",D1)-1)&",*",Codes!$A$1:$A$100,0),
MATCH("*,"&LEFT(D1,SEARCH("-",D1)-1)&"*",Codes!$A$1:$A$100,0)))
<>
IFERROR(MATCH(RIGHT(D1,LEN(D1)-SEARCH("-",D1)),Codes!$B$1:$B$100,0),
IFERROR(MATCH("*"&RIGHT(D1,LEN(D1)-SEARCH("-",D1))&",*",Codes!$B$1:$B$100,0),
MATCH("*,"&RIGHT(D1,LEN(D1)-SEARCH("-",D1))&"*",Codes!$B$1:$B$100,0))),
"Different rows",
INDEX(Codes!C:C,IFERROR(MATCH(RIGHT(D1,LEN(D1)-SEARCH("-",D1)),Codes!$B$1:$B$100,0),
IFERROR(MATCH("*"&RIGHT(D1,LEN(D1)-SEARCH("-",D1))&",*",Codes!$B$1:$B$100,0),
MATCH("*,"&RIGHT(D1,LEN(D1)-SEARCH("-",D1))&"*",Codes!$B$1:$B$100,0))))
)
)
where I used a (hopefully) more readable format and assumed:
"Codes" as the sheet name whose columns "A" ("first" code), "B" ("second" code) and "C" ("Results") are placed
codes pairs are to be placed in column "D" of any sheet
formula is to be placed in column "E" adjacent to above mentioned column "D" cells
you may want to consider a "VBA" approach like the following
Sub main()
Dim codesSht As Worksheet
Dim cell As Range, found As Range, codesRng As Range
Dim index1 As Long
Set codesSht = ThisWorkbook.Worksheets("Codes") '<== change "codes" sheet reference as per your needs
Set codesRng = codesSht.Range("A:B").SpecialCells(xlCellTypeConstants, xlTextValues)
With ThisWorkbook.Worksheets("Results") '<== change "Results" sheet reference as per your needs
For Each cell In .Range("D1:D" & .Cells(.Rows.count, "D").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlTextValues)
Set found = codesRng.Resize(, 1).Find(What:=Split(cell.Value, "-")(0), LookIn:=xlValues, LookAt:=xlPart)
If Not found Is Nothing Then
index1 = found.Row
Set found = codesRng.Offset(, 1).Resize(, 1).Find(What:=Split(cell.Value, "-")(1), LookIn:=xlValues, LookAt:=xlPart)
If Not found Is Nothing Then If found.Row = index1 Then cell.Offset(, 1).Value = codesRng(index1, 3)
End If
Next cell
End With
End Sub
If you put the code you are looking for in Column D, then your formula in Column E, the following formula will accomplish what you are looking for ...
=IF(OR(ISERROR(FIND(LEFT(D2,2),A2)),ISERROR(FIND(RIGHT(D2,2),B2)),LEN(D2)=0),"",C2)
And then fill it down.
The formula searches for the left two characters from the code in Column A. If it's not found, an error is thrown. It also looks for the right two characters from the code in Column B. If it's not found, an error is thrown. If the code you are looking for is blank, no error is thrown, so we need to check that case.
So if there is an error searching for the left part, or an error searching for the right part, or there is no code to look for, return a blank. Otherwise, return the result.
Below are some examples ...
Updated based on comments
On Sheet1, the data looks like this ...
... On Sheet2, we have results like this ...
Where Cell B2 contains this formula (filled down)
{=CONCAT(IF(ISERROR(FIND(LEFT(A2,2),Sheet1!$A$1:$A$3)),"",IF(ISERROR(FIND(RIGHT(A2,2),Sheet1!$B$1:$B$3)),"",IF(LEN(A2)<1,"",Sheet1!$C$1:$C$3))))}
Updated due to version-itis
When all else fails, go to VBA. Attached is an example Function. It gets the same results as shown above. It is invoked with formula in Column B, filled down ...
=FindResult(A2,Sheet1!$A$1:$A$3,Sheet1!$B$1:$B$3,Sheet1!$C$1:$C$3)
Code ...
Function FindResult(inString As String, LeftRange As Range, RightRange As Range, ReturnRange As Range) As String
Dim strArr() As String
Dim myCellLeft As Range, myCellRight
'initial
FindResult = ""
If LeftRange Is Nothing Then GoTo Done:
If RightRange Is Nothing Then GoTo Done:
If ReturnRange Is Nothing Then GoTo Done:
' get the two halfs
strArr = Split(inString, "-")
If UBound(strArr) < 1 Then GoTo Done:
' Search the left range for the left half, the right range for the right half
For Each myCellLeft In LeftRange
If InStr(1, myCellLeft.Value, strArr(0)) > 0 Then
For Each myCellRight In RightRange.Rows(myCellLeft.Row)
If InStr(1, myCellRight.Value, strArr(1)) > 0 Then
FindResult = ReturnRange.Rows(myCellLeft.Row)
Exit For
End If
Next myCellRight
If FindResult <> "" Then Exit For
End If
Next myCellLeft
' clean up
Done:
Erase strArr
Set myCellLeft = Nothing
Set myCellRight = Nothing
End Function
I have been working on the problem below for a while now and I got a very basic version to work without error handling. My goal is to have this macro run from the personal macro workbook.
I am importing pipe delimited text files from various sources and none of the formatting in the headers match (some providers decided to play around with the entire layout). With this issue at hand, I created an Excel workbook named Reference(aka Map) with the incoming files layout and standardized/corrected columns' name formatting.
The good news for me is, the file ID will always be on column A. I have about 65 files that need to processed each month so I need to minimize all possible steps and therefore need to have the Reference workbook closed.
With this, I looked around online and put together most of the solution to pull in the new headers based on the ID located in A3. Yet a dilemma still exists, sometimes the ID on A3 will not exist on the Reference workbook - I need to have the vlookup move down to the next row until the result does not equal #N/A or 0 or blank.
At this point I got the 'Do Loop Until' to find the correct row for the first match - works perfectly with out any code following it.
As soon as the vlookup finds a row with an existing ID, then run the snippet below to populate the remaining headers. The only side effect of the next step is, for some reason rID offsets +1 row, undoing the 'Do Loop until' if the final row does not contain a matching ID.
'> Populate remining headers
For Each cell In rng1
cell.Value = ("=VLOOKUP(" & cID & rID & "," & map & "," & i & ",FALSE)")
i = i + 1
Next
This is what I have so far:
Sub DAc_lookup_headers()
Dim wb1 As Workbook 'Current text/file
Dim map As String 'reference Map
Dim cID As String 'wb1 look up column A
Dim rID As String 'wb1 starting row number
Dim rng1 As Range 'wb1 Collection header range
Dim i As Long 'Index number per cell in range
Set wb1 = ActiveWorkbook
Set rng1 = wb1.ActiveSheet.[A1:G1]
map = ("'C:\Users\x165422\Desktop\New folder\[Reference.xlsx]Ref'!$A$1:$I$13")
rID = 3 'Row where ID is - will increment + 1 if not found
cID = "A" 'Column where ID is
i = 3 'Starting vlookup Index number - to increment per cell in range
'>Look for ID until value is found
Do
wb1.ActiveSheet.[a1].Value = ("=VLOOKUP(" & cID & rID & "," & map & "," & i & ",FALSE)")
rID = rID + 1
Loop Until wb1.ActiveSheet.[a1].Text <> "#N/A" Or "0"
'> Populate remining headers
For Each cell In rng1
cell.Value = ("=VLOOKUP(" & cID & rID & "," & map & "," & i & ",FALSE)")
i = i + 1
Next
'> Convert to values
With rng1
.Value = .Value
End With
End Sub
I'll try to help a bit, because you show effort to learn. I will give you some useful tips regarding overall VBA coding and also regarding your issues. Please try to remember them.
It's difficult to read your code, because your variables are poorly named. In VBA there is a difference between a cell and it's value. In your code you have rng1 and rng2. I see that currently rng1 represents cell's value, and rng2 - a cell itself. I'm not sure if you intentionally did that, but now you will understand it. IF you mean a cell itself, then naming the variable rng2 is well understood. But IF you mean cell's value, naming the variable rng1 is misleading. That's only for being able to read the code more easily. Since you defined this variable as string, I suspect that you are expecting it to receive a value of string type. So, you should name your variable something in relation with it's type, i.e. something beginning with str... or s... which would mean that this variable is of string type, e.g. strValue or sID. preferable approach is to use str, as s could be confused with single type (there is such data type in VBA too). You should apply this logic to every variable that you use. String - str..., long - lng..., integer - int..., double - dbl..., boolean - bln..., etc. One type is kind of specific and you use it here too. It's the object type. Objects are not only objects, they are broken down to many different types, and within your code you use range and workbook objects too. You can name them o... or obj..., or usually it's better to use a more specific name, like rng... (for range) or wb... (for workbook). Usual data type variables take values without Set clause, while objects always need Set in order to be associated with some actual object, like range, workbook, sheet, etc. In your code we see wb2 variable which is a string. As now you know, that's not good.
So, in this case you should rename rng1 if you expect it to be string and not a range and learn to always use this naming convention. Same goes to wb2.
Always use Option Explicit as the topmost line in your code module, before all of the subs. This simply prevents from typos. And that's actually an indispensable line. I always use it and everyone should. After doing this, I see that you code will not run, because cell variable is not defined. Use Dim cell As Range, because cell is actually an object of range type. Set is omitted in this case, because For Each ... In ... Next loop does that for you.
Now your actual problems.
You would find Worksheet.UsedRange useful for determining columns count. That represents the area in a sheet from A1 to the last used cell (that's actually an intersection of the last used column and the last used row). Given that your data spans from the column A and when it ends there are no more data to the right not belonging to any column, you might use ActiveSheet.UsedRange.Columns.Count to get the number of columns in your UsedRange and hopefully in your sheet.
I mentioned UsedRange first, because I wanted you to get acquainted with it. We'll use it to solve the problem of vlookup. So the first step that I would suggest before the vlookup is to find the cell with your ID. We should first dim variables that we'll use, e.g. rng3:
Dim rng3 As Range
Then my suggestion is to find the cell with ID looping through cells in the column A, beginning A3, but not looping until the end of the column, because there are 1m rows, but until we reach the last actually used row:
For Each cell In wb1.ActiveSheet.Range("A3:A" & wb1.ActiveSheet.UsedRange.Rows.Count)
If cell <> "" Then
Set rng3 = cell
Exit For 'we found the value, no need to continue looping, so we exit the For loop
End If
Next 'there is no need to write "cell" after "Next", because VBA knows which loop it is in.
Now, that we have the cell where your ID is, we can put lookups in:
i = 2 'Starting vlookup Index number per cell in range
For Each cell in rng2
cell.Value = "=VLOOKUP(" & rng3.Address & "," & wb2 & "," & i & ",FALSE)" 'again, wb2 is not a nice name for String variable
i = i + 1
Next
I hope here are no typos, as I have not tested it. However, I've double checked the code, it looks ok.
I got it to work with:
Sub DAc_lookup_headers()
Dim wb1 As Workbook 'Current text/file
Dim map As String 'reference Map
Dim cID As String 'wb1 look up column A
Dim rID As String 'wb1 starting row number
Dim rng1 As Range 'wb1 Collection header range
Dim i As Long 'Index number per cell in range
Set wb1 = ActiveWorkbook
Set rng1 = wb1.ActiveSheet.[A1:G1]
map = ("'C:\Users\x165422\Desktop\New folder\[Reference.xlsx]Ref'!$A$1:$I$13")
rID = 2 'Row where ID is - will increment + 1 if not found
cID = "A" 'Column where ID is
i = 3 'Starting vlookup Index number - to increment per cell in range
'>Look for ID until value is found
Do
rID = rID + 1
wb1.ActiveSheet.[a1].Value = ("=VLOOKUP(" & cID & rID & "," & map & "," & i & ",FALSE)")
Loop Until wb1.ActiveSheet.[a1].Text <> "#N/A" Or "0"
'> Populate remining headers
For Each cell In rng1
cell.Value = ("=VLOOKUP(" & cID & rID & "," & map & "," & i & ",FALSE)")
i = i + 1
Next
'> Convert to values
With rng1
.Value = .Value
End With
End Sub
I need assistance finding the next instance of an exact string within a cell.
To be precise, I want to look through a series of headings and find the next instance of a declared variable to obtain the column number, and I want to look through that series of headings to find the next empty cell and save that number, and finally, I'd like to take that first column number, and search from second row until I find the first instance of an empty cell, and save that number into a variable. What I have been doing is this:
With Rows(1)
Set found = .Find(what:=Target, After:=.Cells(1, 1))
End With
But it seems that if I accidentally type "s" it will find the first instance of a cell that contains a string that contains the substring "s" (LastName), and not the first cell that contains only "s".
my fear is that if there are columns with " " in them then my program will not function correctly.
Besides that, I sort by a column and when a cell in that column is empty my program pushes it all the way to the bottom of the list and I am trying to delete that empty cell space.
I tried doing Application.WorksheetFunction.Match, HLookup and VLookup and in general the worksheet functions aren't working for me.
So just to give an example of what I want to do:
I have 10 Columns with headings. I want to find the first instance of a column that
contains exactly the string I send into this class. For instance, if the
columns are "FirstName | LastName | Name", I want it to return "Name"
and not "FirstName".
I want to find a column that the user requests as a sort key and verify it's existence
I also want to find a column that is empty (last column)
Finally, I want to find the last row that has a value in relation to the SortColumn.
If you set the lookat parameter to xlWhole, it will only match the whole contents of the cell, so for example:
With Rows(1)
Set found = .Find(what:=target, After:=.Cells(1, 1), lookat:=xlWhole)
End With
To check whether a value was found, you can check whether found is nothing.
Dim exists As Boolean
If Not found Is Nothing Then exists = True
To locate the first empty cell at the end of a row or column of values, I would use the End property to find the last cell in the row/column containing data, then use Offset to find the next cell:
With Rows(1)
Set found = .Find(what:=target, After:=.Cells(1, 1), lookat:=xlWhole)
End With
Dim emptyCell As Range
If Not found Is Nothing Then
Dim col As Integer
col = found.Column
Set emptyCell = Columns(col).End(xlDown)
emptyCell.Offset(1, 0).Select
End If
However, you can't use this if there are some empty cells in the middle of your table of values. (eg if you have values in A1,A2,A3, then A4 is blank and you have more values in A5,A6,A7).
You can use a do loop:
headerToFind = "Name" 'or whatever header you're looking for
x = 1 'or whatever header row is
y = 1 'or whatever first column with header is
Do Until Cells(x,y) = ""
If Cells(x,y) = headerToFind then
MsgBox "The header you are looking for is in row " & x & ", column " & y
Exit Sub
End If
y = y + 1
Loop
MsgBox "Header not found"
In place of the message boxes, put whatever code you want to do with what you find. The first MsgBox will execute if and when the header is found (with x being equal to the row number and y being the column number). The second MsgBox will execute if the desired header is not found.
I have worksheets A, B and C. Worksheet A contains a column with dates. B and C each contain two columns: one with a date and one with a value. For example
worksheet A:
A B
1 2001-01-01 ---
2 2001-01-02 ---
worksheet B:
A B
1 2001-01-01 1
worksheet C:
A B
1 2001-01-02 2
I'd like to have a function =Search(W, date) that when run from worksheet A returns a value assigned to date in worksheet W. For example Search(C, "2001-01-02")=2.
This is an abstract version of searching for currency rates at given dates: multiple worksheets contain rates for currencies, so when we search, we know what worksheet (currency) to pick.
How to define such a function? I tried passing parameters to a custom macro, but excel keeps giving me cryptic errors. It's seems easy to use a macro that uses the selected cell as a source, but a function would be better.
EDIT: my attempt, doesn't work
Function FindRate()
Dim FindString As String
Dim Rate As String
Dim Src As Range
Dim Found As Boolean
MsgBox sheet_name
Rate = "Not found "
Set Src = Application.ActiveCell
FindString = "2006-12-19"
Sheets("cur CHF").Activate
Found = False
For Each c In [A1:C2000]
If c.Value = FindString Then
Rate = c.Offset(0, 1).Value
Found = True
Exit For
End If
Next
MsgBox Rate
'FindRate = Rate
End Function
Function Rate(cname As String)
Dim sheet_name As String
Dim c2s As New Collection
c2s.Add "cur worksheet name", "cur"
sheet_name = c2s.Item(cname)
Call FindRate(sheet_name)
End Function
What you are really doing is a lookup. There is a VLOOKUP function built into Excel that will do exactly what you want. The syntax is
VLOOKUP(lookup_value, table_array, col_index_num, [range_lookup])
This will look up the value lookup_value in the table table_array. It will find an exact match in the first column if range_lookup is false, otherwise it will find the closest value (faster, but data must be sorted).
It will return the value in the col_index_num column.
In your case, if you want the value from sheet B corresponding to "2012-01-01", you would do
=VLOOKUP("2012-01-01", Sheet2!A2:B1000, 2, false)
You may have to mess around with converting the date string into a date value, etc. If you had added the values on Sheet2 as dates, you would want to use
=VLOOKUP(DATEVALUE("2012-01-01"), Sheet2!A2:B1000, 2, false)
since that function correctly converts the string "2012-01-01" to something Excel recognizes as a DATE.
Now if you don't know a priori which sheet you will need to access (because that's a variable), you may have to write yourself a VBA function:
Function myLookup(value, curr)
Dim dval As Long, luTable As Range, s As Worksheet, c As Range
' if user types date as string, convert it to date first...
If VarType(value) = vbString Then
dval = DateValue(value) ' this doesn't work if dval hasn't been declared as `long`!
Else
dval = value
End If
' see if `curr` is the name of a defined range; if so, use it
On Error GoTo notArange
' if the next line doesn't generate an error, then the named range exists:
Set luTable = Range(curr)
' so let's use it...
GoTo evaluateFunction
notArange:
' If we got here, "curr" wasn't the name of a range... it must be the name of a sheet
' first, tell VBA that we're done handling the last error:
Resume here
here:
On Error GoTo noSheet
Set s = ActiveWorkbook.Sheets(curr)
Dim firstCell As Range, lastCell As Range
Set firstCell = s.Range("a1")
Set lastCell = s.Range("b1").End(xlDown) ' assuming data in columns A and B, and contiguous
Set luTable = Range(firstCell, lastCell)
evaluateFunction:
myLookup = Application.WorksheetFunction.VLookup(dval, luTable, 2, False)
Exit Function
noSheet:
' get here if currency not found as either sheet or range --> return an error message
myLookup = curr & " not found!"
End Function
This has been tested on a small sample, and it worked. A few things to note:
You can name the range where the conversion is kept ("euro", "dinar", "yen", ...) instead of keeping each on a separate sheet. You can then pass the name of the range (make it the same as the name of the currency for convenience) as a parameter to your function, and access it with Range(currency). This also gets around the problem of "hard-wiring" the size of the range
The function will check for the existence of a named range, and use it if it exists. If it doesn't, it will look for a sheet with the correct name
If you use an "invalid currency name", this will be reflected in the return value (so myLookup("01-01-2012", "Florins") will return "Florins not found!"
Instead of assuming a lookup table of a certain length, I determine the size of the table dynamically, using the End(xlDown) construct
I allow date to be passed in as a String, or as a DATEVALUE. The function notices the string and converts it
Right now I am setting the range_lookup parameter to False. This means that there must be an exact match, and values that are not present will generate errors. If you prefer to return "the best match", then you set the parameter to True. Now the risk is that you will return garbage when the date requested is outside of your limits. You could solve this by setting the first and last value of the exchange rate column to "no valid data". When the lookup function returns, it will show this value.
This is a simple FindCell function I use a lot is simply extends Excels search function but from what you have got should suit fine. It returns a range however it is simple enough to get the value from the return range. I use it as follows (with comments added for your sake):
Function FindCell(SearchRange As Range, SearchText As Variant, OffsetDown As Integer, OffsetRight As Integer) As Range
'Do a normal search range call using the passed in range and text.
'First try looking formula
Set FindCell = SearchRange.Find(What:=SearchText, LookAt:=xlWhole, LookIn:=xlFormulas, _
MatchCase:=True, SearchOrder:=xlByRows).Offset(OffsetDown, OffsetRight)
'If nothing is found then look in values
If FindCell Is Nothing Then
Set FindCell = SearchRange.Find(What:=SearchText, LookAt:=xlWhole, LookIn:=xlValue, _
MatchCase:=True, SearchOrder:=xlByRows).Offset(OffsetDown, OffsetRight)
End If
End Function
This can be used a function for the rate (you could of course combine the two functions but I use FindCell for many applications so have kept it seperate):
Function GetRate(sWorksheetName As String, theDate As Date) As Double
Dim returnRange As Range
'Call the FindCell function specifying the range to search (column A), and the date and then offset one cell to the right for the value
Set returnRange = FindCell(ThisWorkbook.Worksheets(sWorksheetName).Columns("A:A"), sDate, 0, 1)
'Check if we've found something. If its Nothing then we haven't
If Not returnRange Is Nothing Then GetRate = returnRange.Value
End Function
You can test it in a Sub like so:
Sub Test()
MsgBox "Value is " & GetRate("Sheet2", "2001-01-01")
End Sub
By accepting the GetRate as a date type it shouldn't matter what format the date is in the worksheet.