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
140 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
  • 4
  • 3
7 Comments
 
LVL 10

Accepted Solution

by:
FamousMortimer earned 500 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

Revamp Your Training Process

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action.

Question has a verified solution.

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

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

726 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