VBA Problem When Searching Sheet

LSM1604

New Member
Joined
Jan 8, 2010
Messages
49
http://www.2shared.com/file/10713948/cae642b4/Program_Find_Function_Only.html

Hi All,

I have been trying to work something out for 2 weeks but I cannot seem to do exactly what I would like.

I have posted a download link (at top of post) which has a cut down version of my program, showing the relevant parts to this question. Hopefully the spreadsheet will explain this a bit easier:

Basically, I have created a program where there is a spreadsheet containing all of the items in a loan tools store, which are issued out to people. I have created a "Search/Find" function within the "Issued Items" sheet. Within this search function, you are able to search all or any combination of the following criteria: Serial; Description; Name; Location. For example: If you just type data in the "Serial" field, it will just search that column and select the cells which contain that value.

The problem I am having is when searching multiple criteria, each and every cell in the columns which are searched is selected. Whereas, I would like only the cells which match all of the criteria to be selected.



For example: If I was to type "1" into the "Serial" field, "2" into the "Description" field, "Liam" into the "Name" field, and "Workshop" into the location field:
  • Current: Serial column is searched and all cells with "1" in are selected. Description column is searched and all cells with "2" in are selected. Name column is searched and all cells with "Liam" in are selected. Location column is searched and all cells with "Workshop" in are selected.
  • What I Would Like: Program to search each of the specified columns and only select data which meets the searched criteria. For example: Rows 20 & 28 to be selected as they both contain, Serial "1", Description "2", Name "Liam", Location "Workshop".
Note: The sheet will have password protection.

I hope that makes sense? If there are any problems with my explaination please say.

Any help will be much appreciated.

Cheers,
LSM1604
 

Some videos you may like

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

LSM1604

New Member
Joined
Jan 8, 2010
Messages
49
I forgot to say... If there is an easier way to carry out this, please say! I am new to VBA, only started learning a month ago.

Cheers,
LSM1604
 

gardnertoo

Well-known Member
Joined
Jul 24, 2007
Messages
938
You will get more help if you can post samples of the sheet and the code directly in your post. Very few people are going to go download a file posted by a stranger. Sad to say, there are a lot of malicious people out there, and we have no way to know that you're not one of them. Not saying you are, just that we don't know. You can use the Excel Jeanie utility to create HTML versions of your sheet for inclusion in your post. If you are including code, please enclose it between "code tags": [ code ] at the beginning of the code (minus the spaces) and [ / code ] at the end (again, no spaces). It will look like this:
Code:
Sub DeleteBadNames()
    For Each nm In ActiveWorkbook.Names
    If Right(nm.RefersTo, 4) = "REF!" Then
        nm.Delete
    End If
    Next nm
End Sub
 

LSM1604

New Member
Joined
Jan 8, 2010
Messages
49
As Requested, here is the sheet and the code to go with it (there is a lot of code - anything to simplify it will be much appreciated):

Issued Items


<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial,Arial; FONT-SIZE: 10pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 75px"><COL style="WIDTH: 68px"><COL style="WIDTH: 110px"><COL style="WIDTH: 285px"><COL style="WIDTH: 145px"><COL style="WIDTH: 145px"><COL style="WIDTH: 145px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD></TD><TD>A</TD><TD>B</TD><TD>C</TD><TD>D</TD><TD>E</TD><TD>F</TD><TD>G</TD></TR><TR style="HEIGHT: 50px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">1</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff" colSpan=7></TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff; FONT-SIZE: 12pt; FONT-WEIGHT: bold">Date</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff; FONT-SIZE: 12pt; FONT-WEIGHT: bold">Time</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff; FONT-SIZE: 12pt; FONT-WEIGHT: bold">UTC/Serial</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff; FONT-SIZE: 12pt; FONT-WEIGHT: bold">Description</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff; FONT-SIZE: 12pt; FONT-WEIGHT: bold">Calibration Due</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff; FONT-SIZE: 12pt; FONT-WEIGHT: bold">Name</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff; FONT-SIZE: 12pt; FONT-WEIGHT: bold">Location</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff"></TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="BACKGROUND-COLOR: #ccffff"></TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">10:44:17</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000000026</TD><TD style="BACKGROUND-COLOR: #ccffff">ACW Tool 2</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">10:43:54</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000000024</TD><TD style="BACKGROUND-COLOR: #ccffff">ESW Tool 4</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:50:14</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000837834</TD><TD style="BACKGROUND-COLOR: #ccffff">Multimeter - ITT MX 51EX Intrinsically Safe</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">11/02/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:48:01</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000000023</TD><TD style="BACKGROUND-COLOR: #ccffff">ESW Tool 3</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:47:52</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000000040</TD><TD style="BACKGROUND-COLOR: #ccffff">Small Tap Wrench</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">9</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:47:47</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000000030</TD><TD style="BACKGROUND-COLOR: #ccffff">MSSV Tool 2</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">10</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:47:43</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000000020</TD><TD style="BACKGROUND-COLOR: #ccffff">2T Shackle</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">08/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">11</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:42:26</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000000031</TD><TD style="BACKGROUND-COLOR: #ccffff">6mm Tap Set</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">12</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:42:20</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000000021</TD><TD style="BACKGROUND-COLOR: #ccffff">ESW Tool 1</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">13</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:42:13</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000000011</TD><TD style="BACKGROUND-COLOR: #ccffff">1m 1T Sling</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">30/12/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">14</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:42:09</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000000001</TD><TD style="BACKGROUND-COLOR: #ccffff">Luxmeter</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">15</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:29:36</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000704940</TD><TD style="BACKGROUND-COLOR: #ccffff">Multimeter - Fluke 79 MK II</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">12/08/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">16</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:27:53</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000000025</TD><TD style="BACKGROUND-COLOR: #ccffff">ACW Tool 1</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">17</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:22:42</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0005365744</TD><TD style="BACKGROUND-COLOR: #ccffff">Stopwatch</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">18/11/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">18</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:22:29</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0005365743</TD><TD style="BACKGROUND-COLOR: #ccffff">Stopwatch</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">25/11/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">19</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:22:19</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0005365742</TD><TD style="BACKGROUND-COLOR: #ccffff">Stopwatch</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">18/11/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">20</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:21:34</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000741053</TD><TD style="BACKGROUND-COLOR: #ccffff">Multimeter Probe For 8024B</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">03/12/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">21</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">09:18:47</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0005308008</TD><TD style="BACKGROUND-COLOR: #ccffff">Tachometer - Dynapar Wheel</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">08/07/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">22</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">04/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">14:59:29</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0005355677</TD><TD style="BACKGROUND-COLOR: #ccffff">Loop Calibrator - Fluke 707</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">20/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">gsgd</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">dsdgg</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">23</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">04/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">14:31:37</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000000017</TD><TD style="BACKGROUND-COLOR: #ccffff">1T Shackle</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">05/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">24</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">04/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">14:30:52</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0005122632</TD><TD style="BACKGROUND-COLOR: #ccffff">Loop Calibrator - Fluke 707</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">19/02/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">25</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">04/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">14:21:08</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000000018</TD><TD style="BACKGROUND-COLOR: #ccffff">1T Shackle</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">ighuig1</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">hbv</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">26</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">04/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">14:20:50</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000000028</TD><TD style="BACKGROUND-COLOR: #ccffff">MFP Tool 2</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">ouiiojk</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">jkkljl</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">27</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">04/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">14:20:31</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0000000039</TD><TD style="BACKGROUND-COLOR: #ccffff">14lb Sledgehammer</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">kjk</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">kjb</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">28</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">04/01/2010</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">14:18:33</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">0005391744</TD><TD style="BACKGROUND-COLOR: #ccffff">Thermometer - Fluke 52 MK II</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Liam Manning</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Workshop</TD></TR><TR style="HEIGHT: 18px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">29</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="BACKGROUND-COLOR: #ccffff"></TD></TR></TBODY></TABLE>


Excel tables to the web >> http://www.excel-jeanie-html.de/index.php?f=1" target="_blank"> Excel Jeanie HTML 4


Code:
Private Sub CommandButton_Search_Click()
ActiveWorkbook.Sheets("Issued Items").Activate
Application.ScreenUpdating = False
    Dim FindString1 As String
    Dim FindString2 As String
    Dim FindString3 As String
    Dim FindString4 As String
    Rng1 = ""
    Rng2 = ""
    Rng3 = ""
    Rng4 = ""
    FindString1 = TextBox_UTC.Value
    FindString2 = TextBox_Desc.Value
    FindString3 = TextBox_Name.Value
    FindString4 = TextBox_Location.Value
If TextBox_UTC.Value = "" And TextBox_Desc.Value = "" And TextBox_Name.Value = "" And TextBox_Location.Value = "" Then
    MsgBox "Enter The ""UTC/Serial"" Or ""Description"" Or ""Name"" Or ""Location"" Information!", vbInformation + vbOKOnly, "Error"
    TextBox_UTC.SetFocus
ElseIf TextBox_Desc.Value = "" And TextBox_Name.Value = "" And TextBox_Location.Value = "" Then
    With Sheets("Issued Items").Range("C4:C500")
        Set c = .Find(what:=FindString1, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Application.Goto c, True
            ActiveWindow.ScrollColumn = 1
            Do
                Rng1 = Rng1 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        Else
        MsgBox "The UTC/Serial You Have Entered Is Not Issued!" & vbCrLf & vbCrLf & "      Please Enter A Valid UTC/Serial.", vbInformation + vbOKOnly, "Invalid Entry"
        TextBox_UTC.Value = ""
        TextBox_Desc.Value = ""
        TextBox_Name.Value = ""
        TextBox_Location.Value = ""
        TextBox_UTC.SetFocus
        End If
    End With
    If Rng1 <> "" Then
        Rng1 = Left(Rng1, Len(Rng1) - 1)
        Range(Rng1).Select
        Range("A1").Select
        Union(Range("A1"), Range(Rng1)).Select
    End If
    Unload UserForm10
    Application.ScreenUpdating = True
ElseIf TextBox_UTC.Value = "" And TextBox_Name.Value = "" And TextBox_Location.Value = "" Then
    With Sheets("Issued Items").Range("D4:D500")
        Set c = .Find(what:=FindString2, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Application.Goto c, True
            ActiveWindow.ScrollColumn = 1
            Do
                Rng2 = Rng2 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng2 <> "" Then
        Rng2 = Left(Rng2, Len(Rng2) - 1)
        Range(Rng2).Select
        Range("A1").Select
        Union(Range("A1"), Range(Rng2)).Select
    End If
    Unload UserForm10
    Application.ScreenUpdating = True
ElseIf TextBox_UTC.Value = "" And TextBox_Desc.Value = "" And TextBox_Location.Value = "" Then
    With Sheets("Issued Items").Range("F4:F500")
        Set c = .Find(what:=FindString3, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Application.Goto c, True
            ActiveWindow.ScrollColumn = 1
            Do
                Rng3 = Rng3 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng3 <> "" Then
        Rng3 = Left(Rng3, Len(Rng3) - 1)
        Range(Rng3).Select
        Range("A1").Select
        Union(Range("A1"), Range(Rng3)).Select
    End If
    Unload UserForm10
    Application.ScreenUpdating = True
ElseIf TextBox_UTC.Value = "" And TextBox_Desc.Value = "" And TextBox_Name.Value = "" Then
    With Sheets("Issued Items").Range("G4:G500")
        Set c = .Find(what:=FindString4, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Application.Goto c, True
            ActiveWindow.ScrollColumn = 1
            Do
                Rng4 = Rng4 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng4 <> "" Then
        Rng4 = Left(Rng4, Len(Rng4) - 1)
        Range(Rng4).Select
        Range("A1").Select
        Union(Range("A1"), Range(Rng4)).Select
    End If
    Unload UserForm10
    Application.ScreenUpdating = True
ElseIf TextBox_Name.Value = "" And TextBox_Location.Value = "" Then
    With Sheets("Issued Items").Range("C4:C500")
        Set c = .Find(what:=FindString1, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Application.Goto c, True
            ActiveWindow.ScrollColumn = 1
            Do
                Rng1 = Rng1 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng1 <> "" Then
        Rng1 = Left(Rng1, Len(Rng1) - 1)
        Range(Rng1).Select
    End If
    With Sheets("Issued Items").Range("D4:D500")
        Set c = .Find(what:=FindString2, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng2 = Rng2 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng2 <> "" Then
        Rng2 = Left(Rng2, Len(Rng2) - 1)
        Range("A1").Select
        Union(Range("A1"), Range(Rng2), Range(Rng1)).Select
    End If
    Unload UserForm10
    Application.ScreenUpdating = True
ElseIf TextBox_Desc.Value = "" And TextBox_Location.Value = "" Then
    With Sheets("Issued Items").Range("C4:C500")
        Set c = .Find(what:=FindString1, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Application.Goto c, True
            ActiveWindow.ScrollColumn = 1
            Do
                Rng1 = Rng1 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng1 <> "" Then
        Rng1 = Left(Rng1, Len(Rng1) - 1)
        Range(Rng1).Select
    End If
    With Sheets("Issued Items").Range("F4:F500")
        Set c = .Find(what:=FindString3, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng3 = Rng3 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng3 <> "" Then
        Rng3 = Left(Rng3, Len(Rng3) - 1)
        Range(Rng3).Select
        Range("A1").Select
        Union(Range("A1"), Range(Rng3), Range(Rng1)).Select
    End If
    Unload UserForm10
    Application.ScreenUpdating = True
ElseIf TextBox_Desc.Value = "" And TextBox_Name.Value = "" Then
    With Sheets("Issued Items").Range("C4:C500")
        Set c = .Find(what:=FindString1, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Application.Goto c, True
            ActiveWindow.ScrollColumn = 1
            Do
                Rng1 = Rng1 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng1 <> "" Then
        Rng1 = Left(Rng1, Len(Rng1) - 1)
        Range(Rng1).Select
    End If
    With Sheets("Issued Items").Range("G4:G500")
        Set c = .Find(what:=FindString4, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng4 = Rng4 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng4 <> "" Then
        Rng4 = Left(Rng4, Len(Rng4) - 1)
        Range(Rng4).Select
        Range("A1").Select
        Union(Range("A1"), Range(Rng4), Range(Rng1)).Select
    End If
    Unload UserForm10
    Application.ScreenUpdating = True
ElseIf TextBox_UTC.Value = "" And TextBox_Location.Value = "" Then
    With Sheets("Issued Items").Range("D4:D500")
        Set c = .Find(what:=FindString2, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Application.Goto c, True
            ActiveWindow.ScrollColumn = 1
            Do
                Rng2 = Rng2 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng2 <> "" Then
        Rng2 = Left(Rng2, Len(Rng2) - 1)
        Range(Rng2).Select
    End If
    With Sheets("Issued Items").Range("F4:F500")
        Set c = .Find(what:=FindString3, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng3 = Rng3 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng3 <> "" Then
        Rng3 = Left(Rng3, Len(Rng3) - 1)
        Range(Rng3).Select
        Range("A1").Select
        Union(Range("A1"), Range(Rng3), Range(Rng2)).Select
    End If
    Unload UserForm10
    Application.ScreenUpdating = True
ElseIf TextBox_UTC.Value = "" And TextBox_Name.Value = "" Then
    With Sheets("Issued Items").Range("D4:D500")
        Set c = .Find(what:=FindString2, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Application.Goto c, True
            ActiveWindow.ScrollColumn = 1
            Do
                Rng2 = Rng2 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng2 <> "" Then
        Rng2 = Left(Rng2, Len(Rng2) - 1)
        Range(Rng2).Select
    End If
    With Sheets("Issued Items").Range("G4:G500")
        Set c = .Find(what:=FindString4, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng4 = Rng4 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng4 <> "" Then
        Rng4 = Left(Rng4, Len(Rng4) - 1)
        Range(Rng4).Select
        Range("A1").Select
        Union(Range("A1"), Range(Rng4), Range(Rng2)).Select
    End If
    Unload UserForm10
    Application.ScreenUpdating = True
ElseIf TextBox_UTC.Value = "" And TextBox_Desc.Value = "" Then
    With Sheets("Issued Items").Range("F4:F500")
        Set c = .Find(what:=FindString3, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Application.Goto c, True
            ActiveWindow.ScrollColumn = 1
            Do
                Rng3 = Rng3 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng3 <> "" Then
        Rng3 = Left(Rng3, Len(Rng3) - 1)
        Range(Rng3).Select
    End If
    With Sheets("Issued Items").Range("G4:G500")
        Set c = .Find(what:=FindString4, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng4 = Rng4 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng4 <> "" Then
        Rng4 = Left(Rng4, Len(Rng4) - 1)
        Range(Rng4).Select
        Range("A1").Select
        Union(Range("A1"), Range(Rng4), Range(Rng3)).Select
    End If
    Unload UserForm10
    Application.ScreenUpdating = True
ElseIf TextBox_Location.Value = "" Then
    With Sheets("Issued Items").Range("C4:C500")
        Set c = .Find(what:=FindString1, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Application.Goto c, True
            ActiveWindow.ScrollColumn = 1
            Do
                Rng1 = Rng1 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng1 <> "" Then
        Rng1 = Left(Rng1, Len(Rng1) - 1)
        Range(Rng1).Select
    End If
    With Sheets("Issued Items").Range("D4:D500")
        Set c = .Find(what:=FindString2, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng2 = Rng2 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng2 <> "" Then
        Rng2 = Left(Rng2, Len(Rng2) - 1)
        Range(Rng2).Select
        Union(Range(Rng2), Range(Rng1)).Select
    End If
    With Sheets("Issued Items").Range("F4:F500")
        Set c = .Find(what:=FindString3, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng3 = Rng3 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng3 <> "" Then
        Rng3 = Left(Rng3, Len(Rng3) - 1)
        Range(Rng3).Select
        Range("A1").Select
        Union(Range("A1"), Range(Rng3), Range(Rng2), Range(Rng1)).Select
    End If
    Unload UserForm10
    Application.ScreenUpdating = True
ElseIf TextBox_Name.Value = "" Then
    With Sheets("Issued Items").Range("C4:C500")
        Set c = .Find(what:=FindString1, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Application.Goto c, True
            ActiveWindow.ScrollColumn = 1
            Do
                Rng1 = Rng1 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng1 <> "" Then
        Rng1 = Left(Rng1, Len(Rng1) - 1)
        Range(Rng1).Select
    End If
    With Sheets("Issued Items").Range("D4:D500")
        Set c = .Find(what:=FindString2, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng2 = Rng2 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng2 <> "" Then
        Rng2 = Left(Rng2, Len(Rng2) - 1)
        Range(Rng2).Select
        Union(Range(Rng2), Range(Rng1)).Select
    End If
    With Sheets("Issued Items").Range("G4:G500")
        Set c = .Find(what:=FindString4, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng4 = Rng4 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng4 <> "" Then
        Rng4 = Left(Rng4, Len(Rng4) - 1)
        Range(Rng4).Select
        Range("A1").Select
        Union(Range("A1"), Range(Rng4), Range(Rng2), Range(Rng1)).Select
    End If
    Unload UserForm10
    Application.ScreenUpdating = True
ElseIf TextBox_Desc.Value = "" Then
    With Sheets("Issued Items").Range("C4:C500")
        Set c = .Find(what:=FindString1, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Application.Goto c, True
            ActiveWindow.ScrollColumn = 1
            Do
                Rng1 = Rng1 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng1 <> "" Then
        Rng1 = Left(Rng1, Len(Rng1) - 1)
        Range(Rng1).Select
    End If
    With Sheets("Issued Items").Range("F4:F500")
        Set c = .Find(what:=FindString3, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng3 = Rng3 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng3 <> "" Then
        Rng3 = Left(Rng3, Len(Rng3) - 1)
        Range(Rng3).Select
        Union(Range(Rng3), Range(Rng1)).Select
    End If
    With Sheets("Issued Items").Range("G4:G500")
        Set c = .Find(what:=FindString4, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng4 = Rng4 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng4 <> "" Then
        Rng4 = Left(Rng4, Len(Rng4) - 1)
        Range(Rng4).Select
        Range("A1").Select
        Union(Range("A1"), Range(Rng4), Range(Rng3), Range(Rng1)).Select
    End If
    Unload UserForm10
    Application.ScreenUpdating = True
ElseIf TextBox_UTC.Value = "" Then
    With Sheets("Issued Items").Range("D4:D500")
        Set c = .Find(what:=FindString2, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Application.Goto c, True
            ActiveWindow.ScrollColumn = 1
            Do
                Rng2 = Rng2 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng2 <> "" Then
        Rng2 = Left(Rng2, Len(Rng2) - 1)
        Range(Rng2).Select
    End If
    With Sheets("Issued Items").Range("F4:F500")
        Set c = .Find(what:=FindString3, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng3 = Rng3 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng3 <> "" Then
        Rng3 = Left(Rng3, Len(Rng3) - 1)
        Range(Rng3).Select
        Union(Range(Rng3), Range(Rng2)).Select
    End If
    With Sheets("Issued Items").Range("G4:G500")
        Set c = .Find(what:=FindString4, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng4 = Rng4 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng4 <> "" Then
        Rng4 = Left(Rng4, Len(Rng4) - 1)
        Range(Rng4).Select
        Range("A1").Select
        Union(Range("A1"), Range(Rng4), Range(Rng3), Range(Rng2)).Select
    End If
    Unload UserForm10
    Application.ScreenUpdating = True
Else
    With Sheets("Issued Items").Range("C4:C500")
        Set c = .Find(what:=FindString1, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Application.Goto c, True
            ActiveWindow.ScrollColumn = 1
            Do
                Rng1 = Rng1 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng1 <> "" Then
        Rng1 = Left(Rng1, Len(Rng1) - 1)
        Range(Rng1).Select
    End If
    With Sheets("Issued Items").Range("D4:D500")
        Set c = .Find(what:=FindString2, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng2 = Rng2 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng2 <> "" Then
        Rng2 = Left(Rng2, Len(Rng2) - 1)
        Range(Rng2).Select
        Union(Range(Rng2), Range(Rng1)).Select
    End If
    With Sheets("Issued Items").Range("F4:F500")
        Set c = .Find(what:=FindString3, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng3 = Rng3 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng3 <> "" Then
        Rng3 = Left(Rng3, Len(Rng3) - 1)
        Range(Rng3).Select
        Union(Range(Rng3), Range(Rng2), Range(Rng1)).Select
    End If
    With Sheets("Issued Items").Range("G4:G500")
        Set c = .Find(what:=FindString4, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            ActiveWindow.ScrollColumn = 1
            Do
                Rng4 = Rng4 & c.Address & ","
                Set c = .FindNext(c)
            Loop While Not (c Is Nothing) And (c.Address <> firstAddress)
        End If
    End With
    If Rng4 <> "" Then
        Rng4 = Left(Rng4, Len(Rng4) - 1)
        Range(Rng4).Select
        Range("A1").Select
        Union(Range("A1"), Range(Rng4), Range(Rng3), Range(Rng2), Range(Rng1)).Select
    End If
    Unload UserForm10
    Application.ScreenUpdating = True
End If
End Sub
 

LSM1604

New Member
Joined
Jan 8, 2010
Messages
49
Hi,

Thank you for the reply. That person does good videos. However, It would be preferable if it was done by VBA code.

Can anyone help here?

Thanks,
LSM
 

Forum statistics

Threads
1,089,214
Messages
5,406,888
Members
403,111
Latest member
Donbozone

This Week's Hot Topics

Top