?
Solved

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

Posted on 2014-07-30
7
Medium Priority
?
145 Views
Last Modified: 2014-07-31
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
0
Comment
Question by:fordraiders
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 3
7 Comments
 
LVL 10

Accepted Solution

by:
FamousMortimer earned 2000 total points
ID: 40229945
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
 
LVL 3

Author Comment

by:fordraiders
ID: 40230151
Set xLast = xSheet.Range("A" & xLast_Row + 1)   <------

will this need to be changed also ?
0
 
LVL 3

Author Comment

by:fordraiders
ID: 40230163
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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 10

Expert Comment

by:FamousMortimer
ID: 40230453
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
 
LVL 3

Author Comment

by:fordraiders
ID: 40230983
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
 
LVL 3

Author Closing Comment

by:fordraiders
ID: 40230984
Thanks for the lead in.
0
 
LVL 10

Expert Comment

by:FamousMortimer
ID: 40231535
Good Job, and thanks for the grade.
0

Featured Post

New benefit for Premium Members - Upgrade now!

Ready to get started with anonymous questions today? It's easy! Learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

764 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question