2 Replies - 680 Views - Last Post: 14 July 2009 - 06:41 AM Rate Topic: -----

#1 staticz  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 10
  • Joined: 14-January 09

Excel VBA help

Posted 13 July 2009 - 10:21 AM

We recently had a member of our staff get let go and because of that I was left to finish up the projects he had been "working" on. One that needs to be completed asap involves working with Excel. I can get my way around in VBA pretty well but this has me stumped. Basically what they have is a big spreadsheet of customer support calls. They have the ability to search all the calls for a key word or customer name and then those specific rows are displayed in a new Excel sheet.

They would like to have the ability to

1. Run the search
2. Have records displayed in new sheet
3. Edit the records in new sheet
4. Save the changes to the record in the new sheet to their original record in the old sheet.

I'm not exactly sure if step 4 is even feasible and was hoping someone might have and idea of about how to go at this problem.

Is This A Good Question/Topic? 0
  • +

Replies To: Excel VBA help

#2 MajorWalrus  Icon User is offline

  • D.I.C Head

Reputation: 10
  • View blog
  • Posts: 115
  • Joined: 22-April 09

Re: Excel VBA help

Posted 13 July 2009 - 01:23 PM

Seems like you've got step 1 taken care of. Right? If I were doing this, I'd have the user open the records in a form window, edit them there, and then save back to the sheet. That way you won't have to mess with creating and deleting sheets.

Do you have a code we can look at?
Was This Post Helpful? 0
  • +
  • -

#3 staticz  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 10
  • Joined: 14-January 09

Re: Excel VBA help

Posted 14 July 2009 - 06:41 AM

Steps 1 and 2 are both done, and since you could edit the sheet I guess step 3 is done as well. It is step 4 that I am struggling with. And I would be more than happy to post the search code. My understanding was that the search capability was simply for them to print reports. Now they want to be able to edit the rows from the search, which could be several rows.

I will say that the search code is very messy and I didn't write it, but it does work so I have to give it to him. Anyways to search the spreadsheet you click on a "search" button and it pulls up a form that has all of the columns laid out nicely. You can search on one or more of those fields.

I'm not sure how helpful the code will be, but the way the search works is that you click a button on the spreadsheet that pulls up a form listing all the columns on the sheet, laid out in a logical order. The have the ability to search on one or more fields and then the results are displayed in a new sheet that is deleted upon closing the workbook.

Here is the code:
[code]

Private Sub btnSearch_Click()

Dim FoundCount As Double

Dim rFoundA As Range, rFoundB As Range
Dim rFoundC As Range, rFoundD As Range
Dim rFoundE As Range, rFoundF As Range
Dim rFoundG As Range, rFoundH As Range
Dim rFoundI As Range, rFoundJ As Range
Dim rFoundK As Range, rFoundL As Range
Dim rFoundM As Range, rFoundN As Range
Dim rFoundO As Range, rFoundP As Range
Dim rFoundQ As Range, rFoundR As Range
Dim rFoundS As Range, rFoundT As Range

Dim MyTextA As String, MyTextB As String
Dim MyTextC As String, MyTextD As String
Dim MyTextE As String, MyTextF As String
Dim MyTextG As String, MyTextH As String
Dim MyTextI As String, MyTextJ As String
Dim MyTextK As String, MyTextL As String
Dim MyTextM As String, MyTextN As String
Dim MyTextO As String, MyTextP As String
Dim MyTextQ As String, MyTextR As String
Dim MyTextS As String, MyTextT As String


Dim A As Range, B As Range, C As Range
Dim D As Range, E As Range, F As Range
Dim G As Range, H As Range, I As Range
Dim J As Range, K As Range, L As Range
Dim M As Range, N As Range, O As Range
Dim P As Range, Q As Range, R As Range
Dim S As Range, T As Range

Dim rA As Range, rB As Range, rC As Range
Dim rD As Range, rE As Range, rF As Range
Dim rG As Range, rH As Range, rI As Range
Dim rJ As Range, rK As Range, rL As Range
Dim rM As Range, rN As Range, rO As Range
Dim rP As Range, rQ As Range, rR As Range
Dim rS As Range, rT As Range


MyTextA = txtDate.Value
MyTextB = txtTakenBy.Value
MyTextC = txtLastName.Value
MyTextD = txtFirstName.Value
MyTextE = txtPhoneNum.Value
MyTextF = txtSerialNum.Value
MyTextG = txtNNumber.Value
MyTextH = txtMakeModel.Value
MyTextI = txtInstallDate.Value
MyTextJ = txtSalesOrder.Value
MyTextK = txtIssues.Value
If optLiabilityYes.Value = True Then
MyTextL = "Yes"
ElseIf optLiabilityNo.Value = True Then
MyTextL = "No"
ElseIf optLiabilityU.Value = True Then
MyTextL = "Unknown"
ElseIf optLiabilityO.Value = True Then
MyTextL = "Other"
End If
'MyTextL = txtCUSTOMERLIABILTY.Value
MyTextM = cmbTechCodes.Value
MyTextN = txtAdvice.Value
MyTextO = txtRMA.Value
MyTextP = txtReplacePart.Value
MyTextQ = txtSummary.Value
If optFollowUpYes.Value = True Then
MyTextL = "Yes"
ElseIf optFollowUpNo.Value = True Then
MyTextL = "No"
End If
'MyTextR = txtFollowUPCHECK.Value
MyTextS = txtRepairCenter.Value
MyTextT = txtInstaller.Value


Sheets("Search").Range("A2:T65536").ClearContents

'**********AAAAAAAAAAAAAAAAA*********
If Trim(MyTextA) <> "*" And Len(Trim(MyTextA)) > 0 Then
With Worksheets("Contacts")
Set rA = .Range("A1:A65536")
End With
Set rFoundA = rA.Resize(1, 1)
Set A = rA.Find(MyTextA, After:=rFoundA, _
LookIn:=xlValues, _
Lookat:=xlPart)
If Not A Is Nothing Then
firstAddress = A.Address
Do
' we only need to check MyTextC and D since we are only
' here if MyTextB = "*" or is blank
If (InStr(1, A.Offset(0, 1), Trim(MyTextB), vbTextCompare) > 0 _
Or Trim(MyTextB) = "*" _
Or Len(Trim(MyTextB)) = 0) And _
(InStr(1, A.Offset(0, 2), Trim(MyTextC), vbTextCompare) > 0 _
Or Trim(MyTextC) = "*" _
Or Len(Trim(MyTextC)) = 0) And _
(InStr(1, A.Offset(0, 3), Trim(MyTextD), vbTextCompare) > 0 _
Or Trim(MyTextD) = "*" _
Or Len(Trim(MyTextD)) = 0) And _
(InStr(1, A.Offset(0, 4), Trim(MyTextE), vbTextCompare) > 0 _
Or Trim(MyTextE) = "*" _
Or Len(Trim(MyTextE)) = 0) And _
(InStr(1, A.Offset(0, 5), Trim(MyTextF), vbTextCompare) > 0 _
Or Trim(MyTextF) = "*" _
Or Len(Trim(MyTextF)) = 0) And _
(InStr(1, A.Offset(0, 6), Trim(MyTextG), vbTextCompare) > 0 _
Or Trim(MyTextG) = "*" _
Or Len(Trim(MyTextG)) = 0) And _
(InStr(1, A.Offset(0, 7), Trim(MyTextH), vbTextCompare) > 0 _
Or Trim(MyTextH) = "*" _
Or Len(Trim(MyTextH)) = 0) And _
(InStr(1, A.Offset(0, 8), Trim(MyTextI), vbTextCompare) > 0 _
Or Trim(MyTextI) = "*" _
Or Len(Trim(MyTextI)) = 0) Then


lr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
A.EntireRow.Copy Sheets("Search").Rows(lr)
FoundCount = FoundCount + 1
End If

Set A = rA.FindNext(A)
Loop While Not A Is Nothing And A.Address <> firstAddress
End If 'Not A Is Nothing

' ****** column A is wildcard, check Column B C D ****
ElseIf Trim(MyTextB) <> "*" And Len(Trim(MyTextB)) > 0 Then
With Worksheets("Contacts")
Set rB = .Range("B1:B65536")
End With
Set rFoundB = rB.Resize(1, 1)

Set B = rB.Find(MyTextB, After:=rFoundB, _
LookIn:=xlValues, _
Lookat:=xlPart)
If Not B Is Nothing Then
firstAddress = B.Address
Do
' we only need to check MyTextC and D since we are only
' here if MyTextB = "*" or is blank
If (InStr(1, B.Offset(0, 1), Trim(MyTextC), vbTextCompare) > 0 _
Or Trim(MyTextC) = "*" _
Or Len(Trim(MyTextC)) = 0) And _
(InStr(1, B.Offset(0, 2), Trim(MyTextD), vbTextCompare) > 0 _
Or Trim(MyTextD) = "*" _
Or Len(Trim(MyTextD)) = 0) And _
(InStr(1, B.Offset(0, 3), Trim(MyTextE), vbTextCompare) > 0 _
Or Trim(MyTextE) = "*" _
Or Len(Trim(MyTextE)) = 0) And _
(InStr(1, B.Offset(0, 4), Trim(MyTextF), vbTextCompare) > 0 _
Or Trim(MyTextF) = "*" _
Or Len(Trim(MyTextF)) = 0) And _
(InStr(1, B.Offset(0, 5), Trim(MyTextG), vbTextCompare) > 0 _
Or Trim(MyTextG) = "*" _
Or Len(Trim(MyTextG)) = 0) And _
(InStr(1, B.Offset(0, 6), Trim(MyTextH), vbTextCompare) > 0 _
Or Trim(MyTextH) = "*" _
Or Len(Trim(MyTextH)) = 0) And _
(InStr(1, B.Offset(0, 7), Trim(MyTextI), vbTextCompare) > 0 _
Or Trim(MyTextI) = "*" _
Or Len(Trim(MyTextI)) = 0) Then

If (InStr(1, B.Offset(0, 8), Trim(MyTextJ), vbTextCompare) > 0 _
Or Trim(MyTextJ) = "*" _
Or Len(Trim(MyTextJ)) = 0) And _
(InStr(1, B.Offset(0, 9), Trim(MyTextK), vbTextCompare) > 0 _
Or Trim(MyTextK) = "*" _
Or Len(Trim(MyTextK)) = 0) And _
(InStr(1, B.Offset(0, 10), Trim(MyTextL), vbTextCompare) > 0 _
Or Trim(MyTextL) = "*" _
Or Len(Trim(MyTextL)) = 0) And _
(InStr(1, B.Offset(0, 11), Trim(MyTextM), vbTextCompare) > 0 _
Or Trim(MyTextM) = "*" _
Or Len(Trim(MyTextM)) = 0) And _
(InStr(1, B.Offset(0, 12), Trim(MyTextN), vbTextCompare) > 0 _
Or Trim(MyTextN) = "*" _
Or Len(Trim(MyTextN)) = 0) And _
(InStr(1, B.Offset(0, 13), Trim(MyTextO), vbTextCompare) > 0 _
Or Trim(MyTextO) = "*" _
Or Len(Trim(MyTextO)) = 0) And _
(InStr(1, B.Offset(0, 14), Trim(MyTextP), vbTextCompare) > 0 _
Or Trim(MyTextP) = "*" _
Or Len(Trim(MyTextP)) = 0) And _
(InStr(1, B.Offset(0, 15), Trim(MyTextQ), vbTextCompare) > 0 _
Or Trim(MyTextQ) = "*" _
Or Len(Trim(MyTextQ)) = 0) Then


If (InStr(1, B.Offset(0, 16), Trim(MyTextR), vbTextCompare) > 0 _
Or Trim(MyTextR) = "*" _
Or Len(Trim(MyTextR)) = 0) And _
(InStr(1, B.Offset(0, 17), Trim(MyTextS), vbTextCompare) > 0 _
Or Trim(MyTextS) = "*" _
Or Len(Trim(MyTextS)) = 0) And _
(InStr(1, B.Offset(0, 18), Trim(MyTextT), vbTextCompare) > 0 _
Or Trim(MyTextT) = "*" _
Or Len(Trim(MyTextT)) = 0) Then
lr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
B.EntireRow.Copy Sheets("Search").Rows(lr)
FoundCount = FoundCount + 1
End If
End If
End If
Set B = rB.FindNext(B)
Loop While Not B Is Nothing And B.Address <> firstAddress
End If 'Not B Is Nothing

'******* Look at C and Check D *******
ElseIf Trim(MyTextC) <> "*" And Len(Trim(MyTextC)) > 0 Then
With Worksheets("Contacts")
Set rC = .Range("C1:C65536")
End With
Set rFoundC = rC.Resize(1, 1)
Set C = rC.Find(MyTextC, After:=rFoundC, LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Address
Do
If (InStr(1, C.Offset(0, 1), Trim(MyTextD), vbTextCompare) > 0 _
Or Trim(MyTextD) = "*" _
Or Len(Trim(MyTextD)) = 0) And _
(InStr(1, C.Offset(0, 2), Trim(MyTextE), vbTextCompare) > 0 _
Or Trim(MyTextE) = "*" _
Or Len(Trim(MyTextE)) = 0) And _
(InStr(1, C.Offset(0, 3), Trim(MyTextF), vbTextCompare) > 0 _
Or Trim(MyTextF) = "*" _
Or Len(Trim(MyTextF)) = 0) And _
(InStr(1, C.Offset(0, 4), Trim(MyTextG), vbTextCompare) > 0 _
Or Trim(MyTextG) = "*" _
Or Len(Trim(MyTextG)) = 0) And _
(InStr(1, C.Offset(0, 5), Trim(MyTextH), vbTextCompare) > 0 _
Or Trim(MyTextH) = "*" _
Or Len(Trim(MyTextH)) = 0) And _
(InStr(1, C.Offset(0, 6), Trim(MyTextI), vbTextCompare) > 0 _
Or Trim(MyTextI) = "*" _
Or Len(Trim(MyTextI)) = 0) Then

If (InStr(1, C.Offset(0, 7), Trim(MyTextJ), vbTextCompare) > 0 _
Or Trim(MyTextJ) = "*" _
Or Len(Trim(MyTextJ)) = 0) And _
(InStr(1, C.Offset(0, 8), Trim(MyTextK), vbTextCompare) > 0 _
Or Trim(MyTextK) = "*" _
Or Len(Trim(MyTextK)) = 0) And _
(InStr(1, C.Offset(0, 9), Trim(MyTextL), vbTextCompare) > 0 _
Or Trim(MyTextL) = "*" _
Or Len(Trim(MyTextL)) = 0) And _
(InStr(1, C.Offset(0, 10), Trim(MyTextM), vbTextCompare) > 0 _
Or Trim(MyTextM) = "*" _
Or Len(Trim(MyTextM)) = 0) And _
(InStr(1, C.Offset(0, 11), Trim(MyTextN), vbTextCompare) > 0 _
Or Trim(MyTextN) = "*" _
Or Len(Trim(MyTextN)) = 0) And _
(InStr(1, C.Offset(0, 12), Trim(MyTextO), vbTextCompare) > 0 _
Or Trim(MyTextO) = "*" _
Or Len(Trim(MyTextO)) = 0) And _
(InStr(1, C.Offset(0, 13), Trim(MyTextP), vbTextCompare) > 0 _
Or Trim(MyTextP) = "*" _
Or Len(Trim(MyTextP)) = 0) And _
(InStr(1, C.Offset(0, 14), Trim(MyTextQ), vbTextCompare) > 0 _
Or Trim(MyTextQ) = "*" _
Or Len(Trim(MyTextQ)) = 0) Then


If (InStr(1, C.Offset(0, 15), Trim(MyTextR), vbTextCompare) > 0 _
Or Trim(MyTextR) = "*" _
Or Len(Trim(MyTextR)) = 0) And _
(InStr(1, C.Offset(0, 16), Trim(MyTextS), vbTextCompare) > 0 _
Or Trim(MyTextS) = "*" _
Or Len(Trim(MyTextS)) = 0) And _
(InStr(1, C.Offset(0, 17), Trim(MyTextT), vbTextCompare) > 0 _
Or Trim(MyTextT) = "*" _
Or Len(Trim(MyTextT)) = 0) Then
lr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
C.EntireRow.Copy Sheets("Search").Rows(lr)
FoundCount = FoundCount + 1
End If
End If
End If
Set C = rC.FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If 'Not C Is Nothing

'*******************************************************************************
ElseIf Trim(MyTextD) <> "*" And Len(Trim(MyTextD)) > 0 Then
With Worksheets("Contacts")
Set rD = .Range("D1:D65536")
End With
Set rFoundD = rD.Resize(1, 1)
Set D = rD.Find(MyTextD, After:=rFoundD, LookIn:=xlValues)
If Not D Is Nothing Then
firstAddress = D.Address
Do
If (InStr(1, D.Offset(0, 1), Trim(MyTextE), vbTextCompare) > 0 _
Or Trim(MyTextE) = "*" _
Or Len(Trim(MyTextE)) = 0) And _
(InStr(1, D.Offset(0, 2), Trim(MyTextF), vbTextCompare) > 0 _
Or Trim(MyTextF) = "*" _
Or Len(Trim(MyTextF)) = 0) And _
(InStr(1, D.Offset(0, 3), Trim(MyTextG), vbTextCompare) > 0 _
Or Trim(MyTextG) = "*" _
Or Len(Trim(MyTextG)) = 0) And _
(InStr(1, D.Offset(0, 4), Trim(MyTextH), vbTextCompare) > 0 _
Or Trim(MyTextH) = "*" _
Or Len(Trim(MyTextH)) = 0) And _
(InStr(1, D.Offset(0, 5), Trim(MyTextI), vbTextCompare) > 0 _
Or Trim(MyTextI) = "*" _
Or Len(Trim(MyTextI)) = 0) Then

If (InStr(1, D.Offset(0, 6), Trim(MyTextJ), vbTextCompare) > 0 _
Or Trim(MyTextJ) = "*" _
Or Len(Trim(MyTextJ)) = 0) And _
(InStr(1, D.Offset(0, 7), Trim(MyTextK), vbTextCompare) > 0 _
Or Trim(MyTextK) = "*" _
Or Len(Trim(MyTextK)) = 0) And _
(InStr(1, D.Offset(0, 8), Trim(MyTextL), vbTextCompare) > 0 _
Or Trim(MyTextL) = "*" _
Or Len(Trim(MyTextL)) = 0) And _
(InStr(1, D.Offset(0, 9), Trim(MyTextM), vbTextCompare) > 0 _
Or Trim(MyTextM) = "*" _
Or Len(Trim(MyTextM)) = 0) And _
(InStr(1, D.Offset(0, 10), Trim(MyTextN), vbTextCompare) > 0 _
Or Trim(MyTextN) = "*" _
Or Len(Trim(MyTextN)) = 0) And _
(InStr(1, D.Offset(0, 11), Trim(MyTextO), vbTextCompare) > 0 _
Or Trim(MyTextO) = "*" _
Or Len(Trim(MyTextO)) = 0) And _
(InStr(1, D.Offset(0, 12), Trim(MyTextP), vbTextCompare) > 0 _
Or Trim(MyTextP) = "*" _
Or Len(Trim(MyTextP)) = 0) And _
(InStr(1, D.Offset(0, 13), Trim(MyTextQ), vbTextCompare) > 0 _
Or Trim(MyTextQ) = "*" _
Or Len(Trim(MyTextQ)) = 0) Then


If (InStr(1, D.Offset(0, 14), Trim(MyTextR), vbTextCompare) > 0 _
Or Trim(MyTextR) = "*" _
Or Len(Trim(MyTextR)) = 0) And _
(InStr(1, D.Offset(0, 15), Trim(MyTextS), vbTextCompare) > 0 _
Or Trim(MyTextS) = "*" _
Or Len(Trim(MyTextS)) = 0) And _
(InStr(1, D.Offset(0, 16), Trim(MyTextT), vbTextCompare) > 0 _
Or Trim(MyTextT) = "*" _
Or Len(Trim(MyTextT)) = 0) Then
lr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
D.EntireRow.Copy Sheets("Search").Rows(lr)
FoundCount = FoundCount + 1
End If
End If
End If
Set D = rD.FindNext(D)
Loop While Not D Is Nothing And D.Address <> firstAddress
End If 'Not D Is Nothing

'***************************************************************************

ElseIf Trim(MyTextE) <> "*" And Len(Trim(MyTextE)) > 0 Then
With Worksheets("Contacts")
Set rE = .Range("E1:E65536")
End With
Set rFoundE = rE.Resize(1, 1)
Set E = rE.Find(MyTextE, After:=rFoundE, LookIn:=xlValues)
If Not E Is Nothing Then
firstAddress = E.Address
Do
If (InStr(1, E.Offset(0, 1), Trim(MyTextF), vbTextCompare) > 0 _
Or Trim(MyTextF) = "*" _
Or Len(Trim(MyTextF)) = 0) And _
(InStr(1, E.Offset(0, 2), Trim(MyTextG), vbTextCompare) > 0 _
Or Trim(MyTextG) = "*" _
Or Len(Trim(MyTextG)) = 0) And _
(InStr(1, E.Offset(0, 3), Trim(MyTextH), vbTextCompare) > 0 _
Or Trim(MyTextH) = "*" _
Or Len(Trim(MyTextH)) = 0) And _
(InStr(1, E.Offset(0, 4), Trim(MyTextI), vbTextCompare) > 0 _
Or Trim(MyTextI) = "*" _
Or Len(Trim(MyTextI)) = 0) Then

If (InStr(1, E.Offset(0, 5), Trim(MyTextJ), vbTextCompare) > 0 _
Or Trim(MyTextJ) = "*" _
Or Len(Trim(MyTextJ)) = 0) And _
(InStr(1, E.Offset(0, 6), Trim(MyTextK), vbTextCompare) > 0 _
Or Trim(MyTextK) = "*" _
Or Len(Trim(MyTextK)) = 0) And _
(InStr(1, E.Offset(0, 7), Trim(MyTextL), vbTextCompare) > 0 _
Or Trim(MyTextL) = "*" _
Or Len(Trim(MyTextL)) = 0) And _
(InStr(1, E.Offset(0, 8), Trim(MyTextM), vbTextCompare) > 0 _
Or Trim(MyTextM) = "*" _
Or Len(Trim(MyTextM)) = 0) And _
(InStr(1, E.Offset(0, 9), Trim(MyTextN), vbTextCompare) > 0 _
Or Trim(MyTextN) = "*" _
Or Len(Trim(MyTextN)) = 0) And _
(InStr(1, E.Offset(0, 10), Trim(MyTextO), vbTextCompare) > 0 _
Or Trim(MyTextO) = "*" _
Or Len(Trim(MyTextO)) = 0) And _
(InStr(1, E.Offset(0, 11), Trim(MyTextP), vbTextCompare) > 0 _
Or Trim(MyTextP) = "*" _
Or Len(Trim(MyTextP)) = 0) And _
(InStr(1, E.Offset(0, 12), Trim(MyTextQ), vbTextCompare) > 0 _
Or Trim(MyTextQ) = "*" _
Or Len(Trim(MyTextQ)) = 0) Then


If (InStr(1, E.Offset(0, 13), Trim(MyTextR), vbTextCompare) > 0 _
Or Trim(MyTextR) = "*" _
Or Len(Trim(MyTextR)) = 0) And _
(InStr(1, E.Offset(0, 14), Trim(MyTextS), vbTextCompare) > 0 _
Or Trim(MyTextS) = "*" _
Or Len(Trim(MyTextS)) = 0) And _
(InStr(1, E.Offset(0, 15), Trim(MyTextT), vbTextCompare) > 0 _
Or Trim(MyTextT) = "*" _
Or Len(Trim(MyTextT)) = 0) Then

lr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
E.EntireRow.Copy Sheets("Search").Rows(lr)
FoundCount = FoundCount + 1
End If
End If
End If
Set E = rE.FindNext(E)
Loop While Not E Is Nothing And E.Address <> firstAddress
End If 'Not E Is Nothing

'***********************************************************************************
ElseIf Trim(MyTextF) <> "*" And Len(Trim(MyTextF)) > 0 Then
With Worksheets("Contacts")
Set rF = .Range("F1:F65536")
End With
Set rFoundF = rF.Resize(1, 1)
Set F = rF.Find(MyTextF, After:=rFoundF, LookIn:=xlValues)
If Not F Is Nothing Then
firstAddress = F.Address
Do
If (InStr(1, F.Offset(0, 1), Trim(MyTextG), vbTextCompare) > 0 _
Or Trim(MyTextG) = "*" _
Or Len(Trim(MyTextG)) = 0) And _
(InStr(1, F.Offset(0, 2), Trim(MyTextH), vbTextCompare) > 0 _
Or Trim(MyTextH) = "*" _
Or Len(Trim(MyTextH)) = 0) And _
(InStr(1, F.Offset(0, 3), Trim(MyTextI), vbTextCompare) > 0 _
Or Trim(MyTextI) = "*" _
Or Len(Trim(MyTextI)) = 0) Then

If (InStr(1, F.Offset(0, 4), Trim(MyTextJ), vbTextCompare) > 0 _
Or Trim(MyTextJ) = "*" _
Or Len(Trim(MyTextJ)) = 0) And _
(InStr(1, F.Offset(0, 5), Trim(MyTextK), vbTextCompare) > 0 _
Or Trim(MyTextK) = "*" _
Or Len(Trim(MyTextK)) = 0) And _
(InStr(1, F.Offset(0, 6), Trim(MyTextL), vbTextCompare) > 0 _
Or Trim(MyTextL) = "*" _
Or Len(Trim(MyTextL)) = 0) And _
(InStr(1, F.Offset(0, 7), Trim(MyTextM), vbTextCompare) > 0 _
Or Trim(MyTextM) = "*" _
Or Len(Trim(MyTextM)) = 0) And _
(InStr(1, F.Offset(0, 8), Trim(MyTextN), vbTextCompare) > 0 _
Or Trim(MyTextN) = "*" _
Or Len(Trim(MyTextN)) = 0) And _
(InStr(1, F.Offset(0, 9), Trim(MyTextO), vbTextCompare) > 0 _
Or Trim(MyTextO) = "*" _
Or Len(Trim(MyTextO)) = 0) And _
(InStr(1, F.Offset(0, 10), Trim(MyTextP), vbTextCompare) > 0 _
Or Trim(MyTextP) = "*" _
Or Len(Trim(MyTextP)) = 0) And _
(InStr(1, F.Offset(0, 11), Trim(MyTextQ), vbTextCompare) > 0 _
Or Trim(MyTextQ) = "*" _
Or Len(Trim(MyTextQ)) = 0) Then


If (InStr(1, F.Offset(0, 12), Trim(MyTextR), vbTextCompare) > 0 _
Or Trim(MyTextR) = "*" _
Or Len(Trim(MyTextR)) = 0) And _
(InStr(1, F.Offset(0, 13), Trim(MyTextS), vbTextCompare) > 0 _
Or Trim(MyTextS) = "*" _
Or Len(Trim(MyTextS)) = 0) And _
(InStr(1, F.Offset(0, 14), Trim(MyTextT), vbTextCompare) > 0 _
Or Trim(MyTextT) = "*" _
Or Len(Trim(MyTextT)) = 0) Then
lr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
F.EntireRow.Copy Sheets("Search").Rows(lr)
FoundCount = FoundCount + 1
End If
End If
End If
Set F = rF.FindNext(F)
Loop While Not F Is Nothing And F.Address <> firstAddress
End If 'Not F Is Nothing

'***********************************************************************************
ElseIf Trim(MyTextG) <> "*" And Len(Trim(MyTextG)) > 0 Then
With Worksheets("Contacts")
Set rG = .Range("G1:G65536")
End With
Set rFoundG = rG.Resize(1, 1)
Set G = rG.Find(MyTextG, After:=rFoundG, LookIn:=xlValues)
If Not G Is Nothing Then
firstAddress = G.Address
Do
If (InStr(1, G.Offset(0, 1), Trim(MyTextH), vbTextCompare) > 0 _
Or Trim(MyTextH) = "*" _
Or Len(Trim(MyTextH)) = 0) And _
(InStr(1, G.Offset(0, 2), Trim(MyTextI), vbTextCompare) > 0 _
Or Trim(MyTextI) = "*" _
Or Len(Trim(MyTextI)) = 0) Then

If (InStr(1, G.Offset(0, 3), Trim(MyTextJ), vbTextCompare) > 0 _
Or Trim(MyTextJ) = "*" _
Or Len(Trim(MyTextJ)) = 0) And _
(InStr(1, G.Offset(0, 4), Trim(MyTextK), vbTextCompare) > 0 _
Or Trim(MyTextK) = "*" _
Or Len(Trim(MyTextK)) = 0) And _
(InStr(1, G.Offset(0, 5), Trim(MyTextL), vbTextCompare) > 0 _
Or Trim(MyTextL) = "*" _
Or Len(Trim(MyTextL)) = 0) And _
(InStr(1, G.Offset(0, 6), Trim(MyTextM), vbTextCompare) > 0 _
Or Trim(MyTextM) = "*" _
Or Len(Trim(MyTextM)) = 0) And _
(InStr(1, G.Offset(0, 7), Trim(MyTextN), vbTextCompare) > 0 _
Or Trim(MyTextN) = "*" _
Or Len(Trim(MyTextN)) = 0) And _
(InStr(1, G.Offset(0, 8), Trim(MyTextO), vbTextCompare) > 0 _
Or Trim(MyTextO) = "*" _
Or Len(Trim(MyTextO)) = 0) And _
(InStr(1, G.Offset(0, 9), Trim(MyTextP), vbTextCompare) > 0 _
Or Trim(MyTextP) = "*" _
Or Len(Trim(MyTextP)) = 0) And _
(InStr(1, G.Offset(0, 10), Trim(MyTextQ), vbTextCompare) > 0 _
Or Trim(MyTextQ) = "*" _
Or Len(Trim(MyTextQ)) = 0) Then


If (InStr(1, G.Offset(0, 11), Trim(MyTextR), vbTextCompare) > 0 _
Or Trim(MyTextR) = "*" _
Or Len(Trim(MyTextR)) = 0) And _
(InStr(1, G.Offset(0, 12), Trim(MyTextS), vbTextCompare) > 0 _
Or Trim(MyTextS) = "*" _
Or Len(Trim(MyTextS)) = 0) And _
(InStr(1, G.Offset(0, 13), Trim(MyTextT), vbTextCompare) > 0 _
Or Trim(MyTextT) = "*" _
Or Len(Trim(MyTextT)) = 0) Then
lr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
G.EntireRow.Copy Sheets("Search").Rows(lr)
FoundCount = FoundCount + 1
End If
End If
End If
Set G = rG.FindNext(G)
Loop While Not G Is Nothing And G.Address <> firstAddress
End If 'Not G Is Nothing

'***********************************************************************************
ElseIf Trim(MyTextH) <> "*" And Len(Trim(MyTextH)) > 0 Then
With Worksheets("Contacts")
Set rH = .Range("H1:H65536")
End With
Set rFoundH = rH.Resize(1, 1)
Set H = rH.Find(MyTextH, After:=rFoundH, LookIn:=xlValues)
If Not H Is Nothing Then
firstAddress = H.Address
Do
If (InStr(1, H.Offset(0, 1), Trim(MyTextI), vbTextCompare) > 0 _
Or Trim(MyTextI) = "*" _
Or Len(Trim(MyTextI)) = 0) Then

If (InStr(1, H.Offset(0, 2), Trim(MyTextJ), vbTextCompare) > 0 _
Or Trim(MyTextJ) = "*" _
Or Len(Trim(MyTextJ)) = 0) And _
(InStr(1, H.Offset(0, 3), Trim(MyTextK), vbTextCompare) > 0 _
Or Trim(MyTextK) = "*" _
Or Len(Trim(MyTextK)) = 0) And _
(InStr(1, H.Offset(0, 4), Trim(MyTextL), vbTextCompare) > 0 _
Or Trim(MyTextL) = "*" _
Or Len(Trim(MyTextL)) = 0) And _
(InStr(1, H.Offset(0, 5), Trim(MyTextM), vbTextCompare) > 0 _
Or Trim(MyTextM) = "*" _
Or Len(Trim(MyTextM)) = 0) And _
(InStr(1, H.Offset(0, 6), Trim(MyTextN), vbTextCompare) > 0 _
Or Trim(MyTextN) = "*" _
Or Len(Trim(MyTextN)) = 0) And _
(InStr(1, H.Offset(0, 7), Trim(MyTextO), vbTextCompare) > 0 _
Or Trim(MyTextO) = "*" _
Or Len(Trim(MyTextO)) = 0) And _
(InStr(1, H.Offset(0, 8), Trim(MyTextP), vbTextCompare) > 0 _
Or Trim(MyTextP) = "*" _
Or Len(Trim(MyTextP)) = 0) And _
(InStr(1, H.Offset(0, 9), Trim(MyTextQ), vbTextCompare) > 0 _
Or Trim(MyTextQ) = "*" _
Or Len(Trim(MyTextQ)) = 0) Then


If (InStr(1, H.Offset(0, 10), Trim(MyTextR), vbTextCompare) > 0 _
Or Trim(MyTextR) = "*" _
Or Len(Trim(MyTextR)) = 0) And _
(InStr(1, H.Offset(0, 11), Trim(MyTextS), vbTextCompare) > 0 _
Or Trim(MyTextS) = "*" _
Or Len(Trim(MyTextS)) = 0) And _
(InStr(1, H.Offset(0, 12), Trim(MyTextT), vbTextCompare) > 0 _
Or Trim(MyTextT) = "*" _
Or Len(Trim(MyTextT)) = 0) Then
lr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
H.EntireRow.Copy Sheets("Search").Rows(lr)
FoundCount = FoundCount + 1
End If
End If
End If
Set H = rH.FindNext(H)
Loop While Not H Is Nothing And H.Address <> firstAddress
End If 'Not H Is Nothing

'***********************************************************************************
ElseIf Trim(MyTextI) <> "*" And Len(Trim(MyTextI)) > 0 Then
With Worksheets("Contacts")
Set rI = .Range("I1:I65536")
End With
Set rFoundI = rI.Resize(1, 1)
Set I = rI.Find(MyTextI, After:=rFoundI, LookIn:=xlValues)
If Not I Is Nothing Then
firstAddress = I.Address
Do
If (InStr(1, I.Offset(0, 1), Trim(MyTextJ), vbTextCompare) > 0 _
Or Trim(MyTextJ) = "*" _
Or Len(Trim(MyTextJ)) = 0) And _
(InStr(1, I.Offset(0, 2), Trim(MyTextK), vbTextCompare) > 0 _
Or Trim(MyTextK) = "*" _
Or Len(Trim(MyTextK)) = 0) And _
(InStr(1, I.Offset(0, 3), Trim(MyTextL), vbTextCompare) > 0 _
Or Trim(MyTextL) = "*" _
Or Len(Trim(MyTextL)) = 0) And _
(InStr(1, I.Offset(0, 4), Trim(MyTextM), vbTextCompare) > 0 _
Or Trim(MyTextM) = "*" _
Or Len(Trim(MyTextM)) = 0) And _
(InStr(1, I.Offset(0, 5), Trim(MyTextN), vbTextCompare) > 0 _
Or Trim(MyTextN) = "*" _
Or Len(Trim(MyTextN)) = 0) And _
(InStr(1, I.Offset(0, 6), Trim(MyTextO), vbTextCompare) > 0 _
Or Trim(MyTextO) = "*" _
Or Len(Trim(MyTextO)) = 0) And _
(InStr(1, I.Offset(0, 7), Trim(MyTextP), vbTextCompare) > 0 _
Or Trim(MyTextP) = "*" _
Or Len(Trim(MyTextP)) = 0) And _
(InStr(1, I.Offset(0, 8), Trim(MyTextQ), vbTextCompare) > 0 _
Or Trim(MyTextQ) = "*" _
Or Len(Trim(MyTextQ)) = 0) Then


If (InStr(1, I.Offset(0, 9), Trim(MyTextR), vbTextCompare) > 0 _
Or Trim(MyTextR) = "*" _
Or Len(Trim(MyTextR)) = 0) And _
(InStr(1, I.Offset(0, 10), Trim(MyTextS), vbTextCompare) > 0 _
Or Trim(MyTextS) = "*" _
Or Len(Trim(MyTextS)) = 0) And _
(InStr(1, I.Offset(0, 11), Trim(MyTextT), vbTextCompare) > 0 _
Or Trim(MyTextT) = "*" _
Or Len(Trim(MyTextT)) = 0) Then
lr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
I.EntireRow.Copy Sheets("Search").Rows(lr)
FoundCount = FoundCount + 1
End If
End If

Set I = rI.FindNext(I)
Loop While Not I Is Nothing And I.Address <> firstAddress
End If 'Not I Is Nothing

'***********************************************************************************
ElseIf Trim(MyTextJ) <> "*" And Len(Trim(MyTextJ)) > 0 Then
With Worksheets("Contacts")
Set rJ = .Range("J1:J65536")
End With
Set rFoundJ = rJ.Resize(1, 1)
Set J = rJ.Find(MyTextJ, After:=rFoundJ, LookIn:=xlValues)
If Not J Is Nothing Then
firstAddress = J.Address
Do
If (InStr(1, J.Offset(0, 1), Trim(MyTextK), vbTextCompare) > 0 _
Or Trim(MyTextK) = "*" _
Or Len(Trim(MyTextK)) = 0) And _
(InStr(1, J.Offset(0, 2), Trim(MyTextL), vbTextCompare) > 0 _
Or Trim(MyTextL) = "*" _
Or Len(Trim(MyTextL)) = 0) And _
(InStr(1, J.Offset(0, 3), Trim(MyTextM), vbTextCompare) > 0 _
Or Trim(MyTextM) = "*" _
Or Len(Trim(MyTextM)) = 0) And _
(InStr(1, J.Offset(0, 4), Trim(MyTextN), vbTextCompare) > 0 _
Or Trim(MyTextN) = "*" _
Or Len(Trim(MyTextN)) = 0) And _
(InStr(1, J.Offset(0, 5), Trim(MyTextO), vbTextCompare) > 0 _
Or Trim(MyTextO) = "*" _
Or Len(Trim(MyTextO)) = 0) And _
(InStr(1, J.Offset(0, 6), Trim(MyTextP), vbTextCompare) > 0 _
Or Trim(MyTextP) = "*" _
Or Len(Trim(MyTextP)) = 0) And _
(InStr(1, J.Offset(0, 7), Trim(MyTextQ), vbTextCompare) > 0 _
Or Trim(MyTextQ) = "*" _
Or Len(Trim(MyTextQ)) = 0) Then


If (InStr(1, J.Offset(0, 8), Trim(MyTextR), vbTextCompare) > 0 _
Or Trim(MyTextR) = "*" _
Or Len(Trim(MyTextR)) = 0) And _
(InStr(1, J.Offset(0, 9), Trim(MyTextS), vbTextCompare) > 0 _
Or Trim(MyTextS) = "*" _
Or Len(Trim(MyTextS)) = 0) And _
(InStr(1, J.Offset(0, 10), Trim(MyTextT), vbTextCompare) > 0 _
Or Trim(MyTextT) = "*" _
Or Len(Trim(MyTextT)) = 0) Then
lr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
J.EntireRow.Copy Sheets("Search").Rows(lr)
FoundCount = FoundCount + 1
End If
End If

Set J = rJ.FindNext(J)
Loop While Not J Is Nothing And J.Address <> firstAddress
End If 'Not J Is Nothing

'***********************************************************************************
ElseIf Trim(MyTextK) <> "*" And Len(Trim(MyTextK)) > 0 Then
With Worksheets("Contacts")
Set rK = .Range("K1:K65536")
End With
Set rFoundK = rK.Resize(1, 1)
Set K = rK.Find(MyTextK, After:=rFoundK, LookIn:=xlValues)
If Not K Is Nothing Then
firstAddress = K.Address
Do
If (InStr(1, K.Offset(0, 1), Trim(MyTextL), vbTextCompare) > 0 _
Or Trim(MyTextL) = "*" _
Or Len(Trim(MyTextL)) = 0) And _
(InStr(1, K.Offset(0, 2), Trim(MyTextM), vbTextCompare) > 0 _
Or Trim(MyTextM) = "*" _
Or Len(Trim(MyTextM)) = 0) And _
(InStr(1, K.Offset(0, 3), Trim(MyTextN), vbTextCompare) > 0 _
Or Trim(MyTextN) = "*" _
Or Len(Trim(MyTextN)) = 0) And _
(InStr(1, K.Offset(0, 4), Trim(MyTextO), vbTextCompare) > 0 _
Or Trim(MyTextO) = "*" _
Or Len(Trim(MyTextO)) = 0) And _
(InStr(1, K.Offset(0, 5), Trim(MyTextP), vbTextCompare) > 0 _
Or Trim(MyTextP) = "*" _
Or Len(Trim(MyTextP)) = 0) And _
(InStr(1, K.Offset(0, 6), Trim(MyTextQ), vbTextCompare) > 0 _
Or Trim(MyTextQ) = "*" _
Or Len(Trim(MyTextQ)) = 0) Then


If (InStr(1, K.Offset(0, 7), Trim(MyTextR), vbTextCompare) > 0 _
Or Trim(MyTextR) = "*" _
Or Len(Trim(MyTextR)) = 0) And _
(InStr(1, K.Offset(0, 8), Trim(MyTextS), vbTextCompare) > 0 _
Or Trim(MyTextS) = "*" _
Or Len(Trim(MyTextS)) = 0) And _
(InStr(1, K.Offset(0, 9), Trim(MyTextT), vbTextCompare) > 0 _
Or Trim(MyTextT) = "*" _
Or Len(Trim(MyTextT)) = 0) Then
lr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
K.EntireRow.Copy Sheets("Search").Rows(lr)
FoundCount = FoundCount + 1
End If
End If

Set K = rK.FindNext(K)
Loop While Not K Is Nothing And K.Address <> firstAddress
End If 'Not K Is Nothing

'***********************************************************************************
ElseIf Trim(MyTextL) <> "*" And Len(Trim(MyTextL)) > 0 Then
With Worksheets("Contacts")
Set rL = .Range("L1:L65536")
End With
Set rFoundL = rL.Resize(1, 1)
Set L = rL.Find(MyTextL, After:=rFoundL, LookIn:=xlValues)
If Not L Is Nothing Then
firstAddress = L.Address
Do
If (InStr(1, L.Offset(0, 1), Trim(MyTextM), vbTextCompare) > 0 _
Or Trim(MyTextM) = "*" _
Or Len(Trim(MyTextM)) = 0) And _
(InStr(1, L.Offset(0, 2), Trim(MyTextN), vbTextCompare) > 0 _
Or Trim(MyTextN) = "*" _
Or Len(Trim(MyTextN)) = 0) And _
(InStr(1, L.Offset(0, 3), Trim(MyTextO), vbTextCompare) > 0 _
Or Trim(MyTextO) = "*" _
Or Len(Trim(MyTextO)) = 0) And _
(InStr(1, L.Offset(0, 4), Trim(MyTextP), vbTextCompare) > 0 _
Or Trim(MyTextP) = "*" _
Or Len(Trim(MyTextP)) = 0) And _
(InStr(1, L.Offset(0, 5), Trim(MyTextQ), vbTextCompare) > 0 _
Or Trim(MyTextQ) = "*" _
Or Len(Trim(MyTextQ)) = 0) Then


If (InStr(1, L.Offset(0, 6), Trim(MyTextR), vbTextCompare) > 0 _
Or Trim(MyTextR) = "*" _
Or Len(Trim(MyTextR)) = 0) And _
(InStr(1, L.Offset(0, 7), Trim(MyTextS), vbTextCompare) > 0 _
Or Trim(MyTextS) = "*" _
Or Len(Trim(MyTextS)) = 0) And _
(InStr(1, L.Offset(0, 8), Trim(MyTextT), vbTextCompare) > 0 _
Or Trim(MyTextT) = "*" _
Or Len(Trim(MyTextT)) = 0) Then
lr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
L.EntireRow.Copy Sheets("Search").Rows(lr)
FoundCount = FoundCount + 1
End If
End If

Set L = rL.FindNext(L)
Loop While Not L Is Nothing And L.Address <> firstAddress
End If 'Not L Is Nothing

'***********************************************************************************
ElseIf Trim(MyTextM) <> "*" And Len(Trim(MyTextM)) > 0 Then
With Worksheets("Contacts")
Set rM = .Range("M1:M65536")
End With
Set rFoundM = rM.Resize(1, 1)
Set M = rM.Find(MyTextM, After:=rFoundM, LookIn:=xlValues)
If Not M Is Nothing Then
firstAddress = M.Address
Do
If (InStr(1, M.Offset(0, 1), Trim(MyTextN), vbTextCompare) > 0 _
Or Trim(MyTextN) = "*" _
Or Len(Trim(MyTextN)) = 0) And _
(InStr(1, M.Offset(0, 2), Trim(MyTextO), vbTextCompare) > 0 _
Or Trim(MyTextO) = "*" _
Or Len(Trim(MyTextO)) = 0) And _
(InStr(1, M.Offset(0, 3), Trim(MyTextP), vbTextCompare) > 0 _
Or Trim(MyTextP) = "*" _
Or Len(Trim(MyTextP)) = 0) And _
(InStr(1, M.Offset(0, 4), Trim(MyTextQ), vbTextCompare) > 0 _
Or Trim(MyTextQ) = "*" _
Or Len(Trim(MyTextQ)) = 0) Then


If (InStr(1, M.Offset(0, 5), Trim(MyTextR), vbTextCompare) > 0 _
Or Trim(MyTextR) = "*" _
Or Len(Trim(MyTextR)) = 0) And _
(InStr(1, M.Offset(0, 6), Trim(MyTextS), vbTextCompare) > 0 _
Or Trim(MyTextS) = "*" _
Or Len(Trim(MyTextS)) = 0) And _
(InStr(1, M.Offset(0, 7), Trim(MyTextT), vbTextCompare) > 0 _
Or Trim(MyTextT) = "*" _
Or Len(Trim(MyTextT)) = 0) Then
lr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
M.EntireRow.Copy Sheets("Search").Rows(lr)
FoundCount = FoundCount + 1
End If
End If

Set M = rM.FindNext(M)
Loop While Not M Is Nothing And M.Address <> firstAddress
End If 'Not M Is Nothing

'***********************************************************************************
ElseIf Trim(MyTextN) <> "*" And Len(Trim(MyTextN)) > 0 Then
With Worksheets("Contacts")
Set rN = .Range("N1:N65536")
End With
Set rFoundN = rN.Resize(1, 1)
Set N = rN.Find(MyTextN, After:=rFoundN, LookIn:=xlValues)
If Not N Is Nothing Then
firstAddress = N.Address
Do
If (InStr(1, N.Offset(0, 1), Trim(MyTextO), vbTextCompare) > 0 _
Or Trim(MyTextO) = "*" _
Or Len(Trim(MyTextO)) = 0) And _
(InStr(1, N.Offset(0, 2), Trim(MyTextP), vbTextCompare) > 0 _
Or Trim(MyTextP) = "*" _
Or Len(Trim(MyTextP)) = 0) And _
(InStr(1, N.Offset(0, 3), Trim(MyTextQ), vbTextCompare) > 0 _
Or Trim(MyTextQ) = "*" _
Or Len(Trim(MyTextQ)) = 0) Then


If (InStr(1, N.Offset(0, 4), Trim(MyTextR), vbTextCompare) > 0 _
Or Trim(MyTextR) = "*" _
Or Len(Trim(MyTextR)) = 0) And _
(InStr(1, N.Offset(0, 5), Trim(MyTextS), vbTextCompare) > 0 _
Or Trim(MyTextS) = "*" _
Or Len(Trim(MyTextS)) = 0) And _
(InStr(1, N.Offset(0, 6), Trim(MyTextT), vbTextCompare) > 0 _
Or Trim(MyTextT) = "*" _
Or Len(Trim(MyTextT)) = 0) Then
lr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
N.EntireRow.Copy Sheets("Search").Rows(lr)
FoundCount = FoundCount + 1
End If
End If

Set N = rN.FindNext(N)
Loop While Not N Is Nothing And N.Address <> firstAddress
End If 'Not N Is Nothing

'***********************************************************************************
ElseIf Trim(MyTextO) <> "*" And Len(Trim(MyTextO)) > 0 Then
With Worksheets("Contacts")
Set rO = .Range("O1:O65536")
End With
Set rFoundO = rO.Resize(1, 1)
Set O = rO.Find(MyTextO, After:=rFoundO, LookIn:=xlValues)
If Not O Is Nothing Then
firstAddress = O.Address
Do
If (InStr(1, O.Offset(0, 1), Trim(MyTextP), vbTextCompare) > 0 _
Or Trim(MyTextP) = "*" _
Or Len(Trim(MyTextP)) = 0) And _
(InStr(1, O.Offset(0, 2), Trim(MyTextQ), vbTextCompare) > 0 _
Or Trim(MyTextQ) = "*" _
Or Len(Trim(MyTextQ)) = 0) And _
(InStr(1, O.Offset(0, 3), Trim(M

This post has been edited by staticz: 14 July 2009 - 06:48 AM

Was This Post Helpful? 0
  • +
  • -

Page 1 of 1