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
133 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
PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

 
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

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Excel Formula to split product code 5 16
And OR formula 5 22
Excel VBA get Access table names with ADO 2 21
Excel VBA Select non contiguous cells in a loop 4 30
Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

810 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