upgrading code for excel worksheet routine to find values ALSO in another Column if not found in first column

For Reference:
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28244490.html

Excel 2010
vba
I have a workbook with 3 sheets
Sheet "Main" in Column A, i place numeric and alphanumeric.  Sometimes 30 values.
Sometimes 100 to 300 values.

After i place the value in Column A on the "Main" sheet I press a button and the values are looped one by one from Sheet main and if it finds a match on sheets3 and/or 4 it places data to the right of the requested number.

If it finds multiple matches additional matches are inserted underneath the requested number.


What I need:   I need to also search in Column "F" for the value from Column A.
BUT ONLY IF THE VALUE IS NOT FOUND IN Column A

Sub EB_QMatch()
Dim i          As Long
Dim xLast_Row1 As Long
Dim xLast_Row2 As Long
Dim xLast_Row3 As Long
Dim xOut_Row   As Long
Dim xSKU       As Variant
Dim xMain      As Worksheet
Dim xSearch2   As Worksheet
Dim xSearch3   As Worksheet

Set xMain = Worksheets("Main")
Set xSearch2 = Worksheets("Sheet3")
Set xSearch3 = Worksheets("Sheet4")

xLast_Row1 = xMain.UsedRange.Cells(1, 1).Row + xMain.UsedRange.Rows.Count - 1
xLast_Row2 = xSearch2.UsedRange.Cells(1, 1).Row + xSearch2.UsedRange.Rows.Count - 1
xLast_Row3 = xSearch3.UsedRange.Cells(1, 1).Row + xSearch3.UsedRange.Rows.Count - 1

xMain.Activate

If xLast_Row1 < 2 Then
    MsgBox ("No data found in " & xMain.Name & " - run cancelled.")
    Exit Sub
End If

Range("B2:T" & xLast_Row1).ClearContents

Application.ScreenUpdating = True
    For i = xLast_Row1 To 2 Step -1
    
        Debug.Print i
        
        xSKU = Range("A" & i)
        
        If xSKU <> "" Then

            xOut_Row = i
            If xLast_Row2 > 1 Then xOut_Row = Find_Match(xSearch2, xSKU, xOut_Row, i, xLast_Row2)
            If xLast_Row3 > 1 Then xOut_Row = Find_Match(xSearch3, xSKU, xOut_Row, i, xLast_Row3)
            
        Else
            
            Rows(i).Delete Shift:=xlUp
        
        End If
        
    Next

Application.ScreenUpdating = True
' we got no error and can end this
     MsgBox "Data Ready For Review", vbInformation, "EB_Conversion"

    displayData
    FILTERSET
End Sub
      
Function Find_Match(xSheet As Worksheet, xSKU As Variant, ByVal xOut_Row As Long, xMaster_Row As Long, xLast_Row As Long)
Dim xFind As Range
Dim xLast As Range
Dim xFirst As Boolean

xFirst = True


Set xLast = xSheet.Range("A" & xLast_Row + 1)
Do

    Set xFind = xSheet.Range("A:A").Find(what:=xSKU, AFTER:=xLast, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows _
            , searchdirection:=xlNext, MatchCase:=False)
            
    
    If Not xFind Is Nothing Then
        
        If Not xFirst And xFind.Row <= xLast.Row Then
            Set xFind = Nothing         ' We've looped around.
        Else
            Debug.Print "+++ " & xFind.Address
            If xOut_Row <> xMaster_Row Then
                Rows(xOut_Row).Insert Shift:=xlDown
                Rows(xOut_Row).Font.Bold = True
                
             End If
            Range("A" & xOut_Row & ":T" & xOut_Row) = xFind.Offset(0, 0).Resize(1, 20).Value 'copy B:T values
            
            xFirst = False
            Set xLast = xFind
            xOut_Row = xOut_Row + 1
            
            Debug.Print " - " & xFind.Row & " - " & xOut_Row
        End If
        
    End If

Loop Until xFind Is Nothing

Find_Match = xOut_Row

End Function

Open in new window


Thanks
fordraiders
LVL 3
FordraidersAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

FamousMortimerCommented:
Hi,

Will this work for you?

Function Find_Match(xSheet As Worksheet, xSKU As Variant, ByVal xOut_Row As Long, xMaster_Row As Long, xLast_Row As Long)
    Dim xFind As Range
    Dim xLast As Range
    Dim xFirst As Boolean
    
    xFirst = True
    
    
    Set xLast = xSheet.Range("A" & xLast_Row + 1)
    Do
    
        Set xFind = xSheet.Range("A:A").Find(what:=xSKU, AFTER:=xLast, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows _
                , searchdirection:=xlNext, MatchCase:=False)
        
        If xFind Is Nothing Then
            Set xFind = xSheet.Range("F:F").Find(what:=xSKU, AFTER:=xLast, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows _
                        , searchdirection:=xlNext, MatchCase:=False)
        End If
        
        If Not xFind Is Nothing Then
            
            If Not xFirst And xFind.Row <= xLast.Row Then
                Set xFind = Nothing         ' We've looped around.
            Else
                Debug.Print "+++ " & xFind.Address
                If xOut_Row <> xMaster_Row Then
                    Rows(xOut_Row).Insert Shift:=xlDown
                    Rows(xOut_Row).Font.Bold = True
                    
                 End If
                Range("A" & xOut_Row & ":T" & xOut_Row) = xFind.Offset(0, 0).Resize(1, 20).Value 'copy B:T values
                
                xFirst = False
                Set xLast = xFind
                xOut_Row = xOut_Row + 1
                
                Debug.Print " - " & xFind.Row & " - " & xOut_Row
            End If
        Else
            
        End If
    
    Loop Until xFind Is Nothing
    
    Find_Match = xOut_Row

End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
FordraidersAuthor Commented:
Set xLast = xSheet.Range("A" & xLast_Row + 1)   <------

will this need to be changed also ?
0
FordraidersAuthor Commented:
and then this part adjusted also ?
Range("A" & xOut_Row & ":T" & xOut_Row) = xFind.Offset(0, 0).Resize(1, 20).Value 'copy B:T values
to maybe
Range("A" & xOut_Row & ":T" & xOut_Row) = xFind.Offset(0, -5).Resize(1, 20).Value 'copy B:T values

??
\
Thanks
0
Cloud Class® Course: Microsoft Exchange Server

The MCTS: Microsoft Exchange Server 2010 certification validates your skills in supporting the maintenance and administration of the Exchange servers in an enterprise environment. Learn everything you need to know with this course.

FamousMortimerCommented:
To your first question, it should be ok as it's unless you have a different number of rows in each column. Good catch on the second one. I missed that.
0
FordraidersAuthor Commented:
added a couple boolean variables to define the difference in the search columns.

Do


xsSku = True
xMfr = False
Set xLast = xSheet.Range("A" & xLast_Row + 1)
    Set xFind = xSheet.Range("A:A").Find(what:=xSku, AFTER:=xLast, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows _
            , searchdirection:=xlNext, MatchCase:=False)
           
           
            If xFind Is Nothing Then
           xsSku = False
           xMfr = True
            Set xLast = xSheet.Range("F" & xLast_Row + 1)
            Set xFind = xSheet.Range("F:F").Find(what:=xSku, AFTER:=xLast, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows _
                        , searchdirection:=xlNext, MatchCase:=False)
        End If
   
    If Not xFind Is Nothing Then
       
        If Not xFirst And xFind.Row <= xLast.Row Then
            Set xFind = Nothing         ' We've looped around.
        Else
            Debug.Print "+++ " & xFind.Address
            If xOut_Row <> xMaster_Row Then
                Rows(xOut_Row).Insert Shift:=xlDown
                Rows(xOut_Row).Font.Bold = True
               
             End If
             
            If xsSku = True Then
               Range("A" & xOut_Row & ":T" & xOut_Row) = xFind.Offset(0, 0).Resize(1, 20).Value 'copy B:T values
            Else
                  Range("A" & xOut_Row & ":T" & xOut_Row) = xFind.Offset(0, -5).Resize(1, 20).Value 'copy B:T values
            End If
           
           
           
            xFirst = False
            Set xLast = xFind
            xOut_Row = xOut_Row + 1
           
            Debug.Print " - " & xFind.Row & " - " & xOut_Row
        End If
       
    End If

Loop Until xFind Is Nothing
0
FordraidersAuthor Commented:
Thanks for the lead in.
0
FamousMortimerCommented:
Good Job, and thanks for the grade.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.