How I can find string in excel with vba?

Vba code

• QUESTION: Expert Mr. Tom Ogilvy refered me to you. I have following code to copy range and paste inand bring to Outlook. Could you advice the same in MS Word(If you can make copy -Paste special-Bitmap it would be better). I would really appreciate if you could provide me the same. code is below. Sub Mail_Range() 'Working in 2000-2010 Dim Source As Range Dim Dest As Workbook Dim wb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim FileExtStr As String Dim FileFormatNum As Long Dim OutApp As Object Dim OutMail As Object Set Source = Nothing On Error Resume Next Set Source = Range("D4:L51").SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Source Is Nothing Then MsgBox "The source is not a range or the sheet is protected, " & _ "please correct and try again.", vbOKOnly Exit Sub End If With Application .ScreenUpdating = False .EnableEvents = False End With Set wb = ActiveWorkbook Set Dest = Workbooks.Add(xlWBATWorksheet) Source.Copy With Dest.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial Paste:=xlPasteValues .Cells(1).PasteSpecial Paste:=xlPasteFormats .Cells(1).Select Application.CutCopyMode = False End With TempFilePath = Environ$("temp") & "\" TempFileName = "Invoice-" & Source.Parent.Range("G13").Text If Val(Application.Version) Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With Dest .SaveAs TempFilePath & TempFileName & FileExtStr, _ FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = " " .CC = "" .BCC = "" .Subject = "Invoice" .Body = "Please find the attached invoice here with" .Attachments.Add Dest.FullName .Display End With On Error GoTo 0 .Close SaveChanges:=False End With Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Abdul Jaleel ANSWER: I'm not clear why you need to copy anything - surely just emailing thedocument as an attachment would be easiest? If not, was it just a part of the document that needed mailing - and if so, how is it identified? Ron de Bruin explains many tips on emailing from(though you have code for this it might be useful) http://www.rondebruin.nl/sendmail.htm If you can clarify what needs to be sent I can help further. ---------- FOLLOW-UP ---------- QUESTION: I havefile named Invoice where D4:L51 designed for preparing invoice, we want to send to the customer this range attachment in the MS word(preferbaly in Bitmap format). Could you please provide the code for exporting this Range to MSand reaching to the outlook I hope i conveyed my question, eagerly expecting your answer. Thanks Abdul Jaleel Hello I have a workbook. On sheet1 from range A2:O4 every day I need to update value. What I am looking to write a macro, when I update value and run macro it copy the row from 2:5 or range from A2:O4 and paste on sheet2 from range A2. And when I perform this task again it should paste the row or range from next row on sheet2. QUESTION: Hope you are Fine. Now I have Code to copy a range and sending to Outlook.I want text entered in the G13 is also part of the file Name, could you please change code accordingly. in the file where we prepare invoice there is company logo above the invoice and company address below the invoice, is there any way to copy this logo also(it will be possible if we paste- paste special bitmap)or bring the logo in the header and footer. please advice. Sub Mail_Range() 'Working in 2000-2010 Dim Source As Range Dim Dest As Workbook Dim wb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim FileExtStr As String Dim FileFormatNum As Long Dim OutApp As Object Dim OutMail As Object Set Source = Nothing On Error Resume Next Set Source = Range("D4:L51").SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Source Is Nothing Then MsgBox "The source is not a range or the sheet is protected, " & _ "please correct and try again.", vbOKOnly Exit Sub End If With Application .ScreenUpdating = False .EnableEvents = False End With Set wb = ActiveWorkbook Set Dest = Workbooks.Add(xlWBATWorksheet) Source.Copy With Dest.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial Paste:=xlPasteValues .Cells(1).PasteSpecial Paste:=xlPasteFormats .Cells(1).Select Application.CutCopyMode = False End With TempFilePath = Environ$("temp") & "\" TempFileName = "Invoice-" & "G13" If Val(Application.Version) Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With Dest .SaveAs TempFilePath & TempFileName & FileExtStr, _ FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = " " .CC = "" .BCC = "" .Subject = "Invoice" .Body = "Please find the attached invoice here with" .Attachments.Add Dest.FullName .Display End With On Error GoTo 0 .Close SaveChanges:=False End With Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Thanks Abdul Jaleel ANSWER: Abdul Jaleel, TempFileName = "Invoice-" & "G13" would become something like TempFileName = "Invoice-" & source.parent.Range("G13").Text If you already have bitmaps in your worksheet, why not just copy the worksheet and change what you don't want in the file you want to send. Other than that, I couldn't advise you on the bitmaps just using a vague description of saying you have them. ---------- FOLLOW-UP ---------- QUESTION: Thank you, now my file can name as per my requirement. When we click Edit-Paste special-Bitmap is when we pastedirectly. Inbitmap is not availble to paste. Please give me code for make the Gridline invisible in the new file exported. it will look good without Gridline. Do you think is there any way to bring the comapny Logo also in the file exported. because when we send invoice, there should be company Logo in the Invoice. Abdul Jaleel QUESTION: I haveSheet named Invoice which look like a software working is alsmost automatic, which is made with help of your kind assistance and google. i have one more requirement, i would appreciate if you can provide the same. I would like to have a code to copy D4:L51 from the sheet named Invoice and paste in newor word(word is better, but i heard to set reference Micro softobject which i tried it is not installed in our office)new file named with what i enter in the G13of Sheet invoice+word "Invoice", make past special- Bitmap. if not possible paste special-value,format, and column width. this file is sending to the Customer, is it possible to reach file in the out look also by VBA Code. Thanks Abdul Jaleel ANSWER: Abdul Jaleel, what verion ofdo you have. It sounds like you want to have a PDF file. If you have2007, you can save a PDF. If not, then you would need a third party PDF program. There are several that are either cheap or free as I understand it. (in Excel 2007, I believe you have to download an addin to print a PDF file directly from Excel). let me know. Ron de Bruin has all kinds of sample code for sending email fromincluding including an attachment in outlook http://www.rondebruin.nl/sendmail.htm ---------- FOLLOW-UP ---------- QUESTION: Ourversion is 2003. exporting tooris sufficient, please provide the code for this. (my file is in Share folder and can access from all branch in our company and they can do it from their Location), if we take from third party, should it be done in all the system? Thanks Abdul Jaleel ANSWER: Abdul Jaleel, If you don't have the MSapplication, there is no easy way to create adocument. So that leave Excel. This should do what you describe. You can then use code from Ron's site if you want to email the file that is produced. Sub ABC() Dim s As String, sh As Worksheet Dim sh1 As Worksheet, r As Range Dim sPath As String sPath = "C:\Myfolder\Myfiles\" ' .PasteSpecial xlValues .PasteSpecial xlFormats End With With sh1.Parent .SaveAs Filename:=sPath & sh.Range("G13").Text & "_Invoice.xls", _ FileFormat:=xlWorkbookNormal .Close Savechanges:=False End With End Sub I put the D4:L51 data starting in A2 on the new sheet/workbook. that can be changed, but you didn't seem appropriate to put it back in D4:L51 on the new sheet and have all that blank space around it. If you still have merged cells on the source sheet, it will again cause problems. ---------- FOLLOW-UP ---------- QUESTION: I hope i am not bothering you.thank you for your patience with me i have MSin my computer,i came to know reference to MSObject to be installed,to work in ms workd, MSdoest look good to send the Customer. please advice if it is possible make in MS Word. Code you provided, opening with new work book but is giving some error message when i remove last part of your Code shown below it is working Fine (With sh1.Parent .SaveAs Filename:=sPath & sh.Range("G13").Text & "_Invoice.xls", _ FileFormat:=xlWorkbookNormal .Close Savechanges:=FalseEnd With End Sub). please advice further. i took the code from Ron's site, it is sending the file to email address mentioned in the code, i want only to reach in the out look page where we can enter the Customer Name.keep on changing email adress in the code doesnt look good. Shoud it be seperate code, or can we combine both code in one module(open new file with Range and sending the file to outlook). I appreciate your patience in this regard. Thanks Abdul Jaleel QUESTION: Thank you so much for your last answer. it is really help full. I havesheet named invoice where set the format from D4:L51 for invoicing. after invoicing, i want to keep copy of invoice for further reference. advice a vba code copy above mendioned range and paste to sheet named data.when the second invoice is prepared it has to copy to Sheet Data below the previous invoice is copied, and same procedure for all invoice, when sheet data1 is full rest copy to Data2 then Data3 For running macro i will insert auto shape and do assighn macro. Abdul Jaleel ANSWER: Abdul Jaleel, This worked for me. It assumes that column D of your invoice will have a value in row 51 so the code can find the bottom of the data each time it is copied. The sheet with the values in D4:L51 should be active each time the code is run. Sub ABC() Dim sh1 As Worksheet, sh As Worksheet Dim i As Long, idex As Long, rw As Long Set sh1 = ActiveSheet For i = 1 To 20 On Error Resume Next Set sh = Worksheets("Data" & i) idex = i On Error GoTo 0 If Not sh Is Nothing Then Exit For End If Next If sh Is Nothing Then idex = 0 Worksheets.Add After:=Worksheets(Worksheets.Count) Set sh = Worksheets(Worksheets.Count) rw = 0 sh.Name = "Data" & idex + 1 End If rw = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row If (sh.Rows.Count - rw) Worksheets.Add After:=Worksheets(Worksheets.Count) Set sh = Worksheets(Worksheets.Count) rw = 0 sh.Name = "Data" & idex + 1 End If rw = rw + 1 sh1.Range("D4:L51").Copy With sh.Cells(rw, "A") .PasteSpecial xlValues .PasteSpecial xlFormats End With End Sub ---------- FOLLOW-UP ---------- QUESTION: Thank you for your swift reply. It is working fine, but only one time, second time i made another invoice,in same range D4:L51 then i am getting following error message. "Run Time Error 1004 this openration requres the merge cell to be identically sized". (I unmerged all merged, still same error message.) I want to copy second invoice below of previous invoice copied in Sheet Data1.and third invoice below the second invoice. when this Sheet is full copy to another sheet Data2. I hope i conveyed my question Abdul Jaleel VBA code. Macro. You solved my last problem. Many Let¡¯s say I have 10 different numbers in a column, but there are some blank cells between the numbers. Sometimes there is 1 blank, sometimes 2, or 3 etc. Let¡¯s further say the active cell is in row 17 and it is blank. How do I find and activate the next non-blank cell, search direction UP, towards row 1? Donald Hayes, Toronto, Canada Reply to I have statement of Account for different company in oneSheet, i inserted filter , auto filter. it is working fine. I want to bring company name automaically as headline top of the page as( Statement of Account of (company name)) when ever i change filter criteria. Can i have VBA Code for this. your answer will be highly appreciated. Abdul Jaleel Hello Jan, I've been able to develop a VBA code to a certain point. The problem is, every time I run the userform the data retrieved is always from the same line regardless of the search parameters I state. What I would like it to do is search for data from another spreadsheet based on "Future Date" and "Restaurant No" entered on userform. Below is a copy of the code so far(2 Private Subs): Private Sub cmdGetData_Click() Dim tb(1 To 3) As String Dim tbx As MSForms.TextBox Dim v(1 To 3) As Date, sh As Worksheet Dim sh1 As Worksheet, dt As Date, r1 As Range Dim r As Range, rr As Range, i As Long, res As Variant Set sh = Worksheets("Daily Sales Summary") Set sh1 = Worksheets("Scheduling") dt = CDate(Me.txtDate.Value) v(1) = DateSerial(Year(dt) - 1, Month(dt), Day(dt)) v(2) = DateSerial(Year(dt) - 2, Month(dt), Day(dt)) v(3) = DateSerial(Year(dt) - 3, Month(dt), Day(dt)) Set r1 = sh1.Range("A6") Set r = sh.Range("A1", sh.Cells(sh.Rows.Count, 1).End(xlUp)) tb(1) = "txt1YrBack" tb(2) = "txt2YrBack" tb(3) = "txt3YrBack" For i = 1 To 3 Set tbx = Me.Controls(tb(i)) res = Application.Match(CLng(v(i)), r, 0) If Not IsError(res) Then Set rr = r(res) tbx.Value = rr.Offset(0, 7).Text Else tbx.Value = "" End If Next End Sub Private Sub cmdSchedule_Click() Dim v1YrBack, v2YrBack, v3YrBack, vNSA, vSchedule v1YrBack = txt1YrBack.Text v2YrBack = txt2YrBack.Text v3YrBack = txt3YrBack.Text vNSA = Application.WorksheetFunction.Average((v1YrBack), (v2YrBack), (v3YrBack)) txtNSA.Text = Format(Val(vNSA), "$####.##") vSchedule = Val(vNSA) / 600 txtSchedule.Text = Format(Val(vSchedule), "##") End Sub QUESTION: I am a novice with VBA inand have been hitting a wall with the following and would greatly appreciate any assistance. I have one workbook with two worksheets - Daily Sales Receipt and Scheduling. I am trying to write a code that automatically looks at each row in Daily Sales Receipt and based on a "future date" and "Restaurant No" given in a userform, finds the data for 1 year back, 2 years back and 3 years back, for that future date and copies that entire row to the worksheet "scheduling". I'm trying to automate a system of "forecasting" based on a 3 year daily average. Any suggestions? I'm able to write the code to calculate the average and schedule based on an arbitrary ratio but I can't figure out how to write the code to pull the data for the previous years from one worksheet and put it in another. ANSWER: Alfred, I like to use the worksheetfunction Match to find dates. Say your dates are in column A of "Daily Sales Receipt" Private Sub CommandButton1_Click() Dim v(1 to 3) as Date, sh as Worksheet Dim sh1 as Worksheet, dt as Date, r1 as Range Dim r as Range, rr as Range, i as Long, res as Variant set sh = Worksheets("Daily Sales Receipt") set sh1 = worksheets("Scheduling") dt = cDate(me.Textbox1.Value) ' future date in textbox1 of useform with the code v(1) = DateSerial(year(dt)-1,Month(dt),day(dt)) v(2) = DateSerial(year(dt)-2,Month(dt),day(dt)) v(3) = DateSerial(year(dt)-3,Month(dt),day(dt)) set r1 = sh1.Range("A10") ' place year -1 data in row 10 set r = sh.Range("A1",sh.cells(sh.rows.count,1).End(xlup)) for i = 1 to 3 res = Application.Match(clng(v(i)),r,0) if not iserror(res) then set rr = r(res) rr.entirerow.copy r1(i) end if Next End Sub this is pseudo code - untested - but I tried to make it as turnkey as possible making assumptions on locations where needed. Hope it gets you started. ---------- FOLLOW-UP ---------- QUESTION: What if I wanted only the net sales info for those respective years to display in my userform when I hit a "retrieve" button and not all the other data? Is that a possibility? I'm attaching images for your reference. ANSWER: Alfred, then assume the net sales are in column F for i = 1 to 3 res = Application.Match(clng(v(i)),r,0) if not iserror(res) then set rr = r(res) rr.entirerow.copy r1(i) end if Next would become Dim tb(1 to 3) as String dim tbx as MSForms.TextBox tb(1) = "Textbox3" tb(2) = "Textbox4" tb(3) = "Textbox5" for i = 1 to 3 set tbx = me.controls(tb(i)) res = Application.Match(clng(v(i)),r,0) if not iserror(res) then set rr = r(res) tbx.Value = sh1.cells(rr.row,"F").Text ' or tbx.Value = rr.offset(0,5).Text end if Next ---------- FOLLOW-UP ---------- QUESTION: Thank you very much Tom. My next question is just for clarification purposes. So, based on the changes made from the initial code to the supplements, to ideally accomplish the retrieval process the code would become: Private Sub cmdGetData_Click() Dim tb(1 To 3) As String Dim tbx As MSForms.TextBox Dim v(1 To 3) As Date, sh As Worksheet Dim sh1 As Worksheet, dt As Date, r1 As Range Dim r As Range, rr As Range, i As Long, res As Variant Set sh = Worksheets("Daily Sales Summary") Set sh1 = Worksheets("Scheduling") dt = CDate(Me.txtDate.Value) v(1) = DateSerial(Year(dt) - 1, Month(dt), Day(dt)) v(2) = DateSerial(Year(dt) - 2, Month(dt), Day(dt)) v(3) = DateSerial(Year(dt) - 3, Month(dt), Day(dt)) Set r1 = sh1.Range("A6") Set r = sh.Range("A1", sh.Cells(sh.Rows.Count, 1).End(xlUp)) tb(1) = "txt1YrBack" tb(2) = "txt2YrBack" tb(3) = "txt3YrBack" For i = 1 To 3 Set tbx = Me.Controls(tb(i)) res = Application.Match(CLng(v(i)), r, 0) If Not IsError(res) Then Set rr = r(res) tbx.Value = rr.Offset(0, 7).Text End If Next End Sub I change "A10" to "A6" Because that is where my first blank space is. I also changed column "F" to "H" because that is where my Net Sales Data is. "tbx.Value = rr.Offset(0, 7).Text" was changed due to "H" being the Net Sales Data column. Thank you so much for your assistance. I've spent a week trying to figure this out. QUESTION: I currently have streaming quotes coming into2003 cell "A1". I need to capture the highest value that appeared in A1 and place that value into B1, and the lowest value that appeared in cell A1 and place that value into C1. Summary A1 = streaming quotes B1 = Highest value that appeared in A1 C1 = Lowest value that appeared in A1 Thank you! ANSWER: Right-click the sheet tab, select View Code, put this in: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub If Application.CountA(Range("B1:C1")) = 0 Then Range("B1:C1") = [a1] If [a1].Value > [b1].Value Then [b1].Value = [a1].Value If [a1].Value End Sub ---------- FOLLOW-UP ---------- QUESTION: In response to a question about streaming data and building Open, high, low, close rows in Excel 2003 someone gave me the following code. Would you help explain it to me? I am not sure how it works. Sorry if this asking too much. Private Sub Worksheet_Calculate() Dim x As Double, y As Double x = Cells(1, 5) ¡®THE LIVE PRICE CELL y = Cells(1, 3) ¡®THE HIGH PRICE CELL If x > y Then Cells(1, 3) = x End If x = Cells(1, 5) ¡®THE LIVE PRICE CELL y = Cells(1, 4) ¡®THE LOW PRICE CELL If x 0 Then Cells(1, 4) = x End If End Sub

• Answer:

  Tom has also been in touch with me to give me more detail on what your plan is - I would SUGGEST setting up atemplate, using a table to hold the data from thefile - I'd put a bookmark in here to use as a reference point. The code could the be modified to create a new document based on the template Dim WrdHold As String Dim appwd As Object On Error GoTo notloaded Set appwd = GetObject(, "Word.Application") notloaded: If Err.Number = 429 Then Set appwd = CreateObject("Word.Application") End If appwd.Visible = True On Error GoTo 0 appwd.documents.Add Template:="Q:\APPS\StevApps\SystTemp\emulation\_Change of address.dot" 'this taken from a real world example - amend to the location of your file This would handle the graphic etc part of the document - if the file is not to be modified, the code could easily protect the document for forms with a password. Saving the file and emailing you already have code for, it's simply a case of changing it from xls to doc HOPEFULLY this gives you what you need - but please email me if I can help further - or reply via this site - I'm at [email protected] Mohammed you say row 2:5, but you also say A2:O4. Not sure which is right, but I will use A2:O4 sub MakeCopy() Dim r as Range, r2 as Range with worksheets("sheet1") set r = .Range("A2:O4") end with with worksheets("sheet2") set r2 = .cells(.rows.count.1).End(xlup).offset(1,0) End with r.copy r2.pastespecial xlvalues r2.pastespecial xlFormats end Sub run this macro whenever you want to copy the data to sheet2. Abdul Jaleel Set Dest = Workbooks.Add(xlWBATWorksheet) ActiveWindow.DisplayGridlines = False Source.Copy With Dest.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial Paste:=xlPasteValues .Cells(1).PasteSpecial Paste:=xlPasteFormats .Cells(1).Select Application.CutCopyMode = False End With That is for turning the gridlines off in the worksheet as you view it. I assume that is what you want. There is a pagesetup command that does it for printing. Here is some code that inserts a picture at cell B9 if the picture is in a file on your drive Sub ABC() Dim sh As Worksheet Dim pic As Picture set sh = Activesheet Set pic = sh.Pictures.Insert("c:\myfolder\mypicture.jpg") pic.Top = sh.Range("B9").Top pic.Left = sh.Range("B9").Left End Sub I don't know anything about the Logo you have or where you want it, but maybe that will give you some ideas. Just as a hint, you can get a lot of code by turning on the macro recorder and performing the action manually. For example, if you wanted to turn off gridlines for printing, you could get all the pagesetup commands by turning on the macro recorder, change a pagesetup setting (print setting) and then turning the macro recorder off. You could then see all the pagesetup commands and how to use them including gridlines for printing. Abdul Jaleel, My expertise isn't inas I only volunteer in theforum. So I don't generally write code for word. Maybe ask experts Aiden Heritage or Richard Ross who both answer questions in theandforums. However, if you just copy and paste the data fromto word, I suspect it will come intoas a Table and I don't see how that will make it look any better. If you are getting an error on that line, I suspect any or all of the following 1) you don't have a "\" on the end of your path location 2) the path you specify is not valid 3) whatever is in G13 is not a valid file name 4) a file already exists with that name in the folder where you are trying to save it with valid values, the code, copied from this posting, worked fine for me. Not sure what you are saying about Ron's code, but I guess you don't want the email to actually send. then remove the .Send command in Ron's code and remove any code that puts in an email address. Can you combine the two routines - certainly you should be able to do that. If nothing else, have one routine that calls each one and passes the filename from the my code to ron's code or add code in ron's routine to build the same filename (as an argument to the command to attach the file which is what I think you are doing). Abdul Jaleel, Your problem is obviously with merged cells. If it tells you there is an error with merged cells, then clearly you did not remove the merged cells. I tested the code including having the first data sheet full and the code correctly created a second data sheet. It all worked flawlessly. so any problems you might have will be because of your environment - something I can not see - i.e. in this case it appears you have merged cells. the best I can do is have the code copy and paste your data. If it works manually, then the code will work. If it doesn't work manually (and I suspect this is your case), then the code won't be able to do what you can't do manually - i.e. you have run into anlimitation. That isn't to say the code could not be modified to account for that limitation - but I don't have your worksheet here to look at or have any idea how it is constructed. Without that information, I can't write code to work around your problem because I can't see it. Best I can do is provide you fully tested code that complies with your problem statement and that is what I did. I am sorry you are disatisfied with the result. Particularly since it was freely given and cost you nothing. "Run Time Error 1004 this openration requres the merge cell to be identically sized". (I unmerged all merged, still same error message.) See how that makes no sense. The error says you have merged cells - but you say you don't. How can I react to that kind of information. >I want to copy second invoice below of previous invoice copied in Sheet Data1.and third invoice below the second invoice. when this Sheet is full copy to another sheet Data2. And it worked perfectly for me with my understanding of your data layout and the assumptions I specified in my answer. >I hope i conveyed my question you have given me no additional information that I can use to change the code. Perhaps you will have better luck with another expert. Sorry - but all I have to go on is what you tell me. Donald, Sub findNextBlank() Dim r As Range, i As Long Set r = ActiveCell For i = r.Row - 1 To 1 Step -1 If Not IsEmpty(Cells(i, r.Column)) Then Cells(i, r.Column).Select Exit For End If Next If r.Address = ActiveCell.Address Then MsgBox "Already at the last non-blank cell closest to row 1" End If End Sub should do it. VB Macro would work fine. But I would rather prefer a way to use Formulae. How may companies are you talking about? How do you determine a Company name? I mean what is unique identifier? Which cell does it appear? May be you can use IF statements (if companies are less than 5) or can use VLOOKUP by maintaining this list of identifier against companies name elsewhere.... Regards I changed the method of searching and now use autofilter. I look for the restaurant number (textbox called txtRest) in column B: Private Sub cmdGetData_Click() Dim tb(1 To 3) As String Dim tbx As MSForms.TextBox Dim v(1 To 3) As Date, sh As Worksheet Dim sh1 As Worksheet, dt As Date, r1 As Range Dim r As Range, rr As Range, i As Long, res As Variant Dim r2 As Range Dim rFound As Range Set sh = Worksheets("Daily Sales Summary") Set sh1 = Worksheets("Scheduling") dt = CDate(Me.txtdate.Value) v(1) = DateSerial(Year(dt) - 1, Month(dt), Day(dt)) v(2) = DateSerial(Year(dt) - 2, Month(dt), Day(dt)) v(3) = DateSerial(Year(dt) - 3, Month(dt), Day(dt)) Set r1 = sh1.Range("A6") Set r = sh.Range("A1", sh.Cells(sh.Rows.Count, 1).End(xlUp)) 'Look for restaurant # in second column Set r2 = r.Offset(, 1) tb(1) = "txt1YrBack" tb(2) = "txt2YrBack" tb(3) = "txt3YrBack" For i = 1 To 3 Set tbx = Me.Controls(tb(i)) sh.AutoFilterMode = False With sh.Range(r, r2) .AutoFilter 1, v(i) .AutoFilter 2, txtRest.Value On Error Resume Next Set rFound = Nothing Set rFound = .Offset(1).SpecialCells(xlCellTypeVisible) End With If Not rFound Is Nothing Then tbx.Value = rFound.Offset(0, 7).Cells(1, 1).Text Else tbx.Value = "" End If Next sh.AutoFilterMode = False End Sub Alfred, It looks good to me. If you are going to keep the userform up and change the date and run another excursion, then you might add code to clear the textbox if no match is found so you don't have a situation where old data mixes with new data. Private Sub cmdGetData_Click() Dim tb(1 To 3) As String Dim tbx As MSForms.TextBox Dim v(1 To 3) As Date, sh As Worksheet Dim sh1 As Worksheet, dt As Date, r1 As Range Dim r As Range, rr As Range, i As Long, res As Variant Set sh = Worksheets("Daily Sales Summary") Set sh1 = Worksheets("Scheduling") dt = CDate(Me.txtDate.Value) v(1) = DateSerial(Year(dt) - 1, Month(dt), Day(dt)) v(2) = DateSerial(Year(dt) - 2, Month(dt), Day(dt)) v(3) = DateSerial(Year(dt) - 3, Month(dt), Day(dt)) Set r1 = sh1.Range("A6") Set r = sh.Range("A1", sh.Cells(sh.Rows.Count, 1).End(xlUp)) tb(1) = "txt1YrBack" tb(2) = "txt2YrBack" tb(3) = "txt3YrBack" For i = 1 To 3 Set tbx = Me.Controls(tb(i)) res = Application.Match(CLng(v(i)), r, 0) If Not IsError(res) Then Set rr = r(res) tbx.Value = rr.Offset(0, 7).Text Else tbx.Value = "" ' clear textbox if new data is not found End If Next End Sub I assume you are aware that dates are stored as the number of days from a base date (Jan 1, 1900). If a time is involved, it is stored a the decimal fraction of a day. so Today if 40242 (date serial number). If I wanted 6 AM today it would be 40242.25 the point of this is match will be looking for 40242 if you supplied today as your date. It would not be successful in finding 40242.25 if that is what is stored in your database. I assumed that would not be the case and the only whole numbers (just dates, no dates and times) would be in the database. Just for information. Private Sub Worksheet_Calculate() 'whenever the worksheet calculates Dim x As Double, y As Double x = Cells(1, 5) ¡®THE LIVE PRICE CELL 'cells(1,5) is E1. Its value is held in "x" y = Cells(1, 3) ¡®THE HIGH PRICE CELL 'cells(1,3) is C1. Its value is held in "y" If x > y Then 'if E1>C1 then Cells(1, 3) = x 'C1 is set to x which WAS E1. End If x = Cells(1, 5) ¡®THE LIVE PRICE CELL 'unnecessary -- same x as before y = Cells(1, 4) ¡®THE LOW PRICE CELL 'cells(1,4) is D1. So now y contains D1's value If x 0 Then 'if E1 less than D1 OR both D1 is 0 and E1>0 then Cells(1, 4) = x 'D1 is set to x which WAS E1. End If End Sub HTH