Searching within 2 columns

I have written code (see attached) that works by looking at the column containing the first name
of an individual, as I had assumed that a first name would always be included (the data to be
inputted comes from various external sources). This turned out not to be the case. However,
either the first and/or last name is always included. So I need to modify this code to have the
procedure look at both columns. I tried modifying the range to include both columns, but this
resulted in a situation where the persons with both first and last names are displayed twice. I'm
not sure how to alter the code to get it to look at both columns, and to only respond once per
row if there is data in either the first or last name column, or both columns.

Attached I've included a example of the data to be inputted ("test data.xlsx"), and the program
that is to import these sheets ("27Dec11 - MasterArmingRoster.xlsm").

Thanks for any help,
Jason
test-data.xlsx
27Dec11---Master-Arming-Roster.xlsm
rjason137Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
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.

James ElliottManaging DirectorCommented:
Can you post the code, I'm on a PC using Office 2000

Without seeing it, you can use something like

For each cel in col1
   If isEmpty(col1) then
     'process col2
   else
      'process col1
   End if
Next cel
0
rjason137Author Commented:
Jell, thanks for the response. I tried applying your suggestion to one of hte portions of code (there will be probably 3 different areas in the code where this concept will need to be applied), and it doesn't seem to be seeing the people who don't have a last name entered for them. Here is the full code with your concept applied to the one area I mentioned:

----------------------------------------------------------

Public Mybook As Workbook
Public ThatBook As Workbook

Sub ImportData()

'turn off certain functions to speed up the processing
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim myWkb As Workbook
Dim myInSht As Worksheet
Dim myInSht1 As Worksheet
Dim myInSht2 As Worksheet
Dim myOutSht As Worksheet
Dim fRange As Range, firstAddress As String
Dim outCursor As Range
Dim searchStr As String
Dim rowsToCopy As Range, myRow As Range

   
'user will be prompted to open the desired Arming Roster workbook
   
    Set Mybook = ActiveWorkbook
    Filename = Application.GetOpenFilename
    Workbooks.Open Filename:=Filename
    Set ThatBook = ActiveWorkbook
    Set myWkb = ThisWorkbook
   
   
'This If/Then procedure differentiates between Arming Roster and Master Arming Roster as the Target Worksheet
   
If ThatBook.Sheets(1).Name = "Arming Roster" Then
   
        Set myOutSht = myWkb.Sheets("Master Arming Roster")
        Set myInSht1 = ThatBook.Sheets("Contract")
        Set myInSht2 = ThatBook.Sheets("Arming Roster")
       
       
    'Reformats (transposes) "Contract" tab data so the code below can interact with it properly
   
        myInSht1.Activate
        Range("C1:Y2").Value = WorksheetFunction.Transpose(Range("C1:D23"))
        Range("C3:D23").Delete
        myInSht2.Activate
       
    'Imports data from "Contract" sheet, inputted by ACOs
       
        Set outCursor = myOutSht.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
       
        searchStr = "*"
       
        With myInSht2.Range("B2", myInSht2.Range("B" & Rows.Count).End(xlUp)) 'search to bottom of used range
       
            Set fRange = .Find(what:=searchStr, LookIn:=xlValues, lookat:=xlWhole)
            If Not fRange Is Nothing Then
                firstAddress = fRange.Address
                Set rowsToCopy = fRange
               
                Do
                    Set fRange = .FindNext(fRange)
                    If Not fRange Is Nothing Then
                        Set rowsToCopy = Union(rowsToCopy, fRange)
                    End If
                Loop While Not fRange Is Nothing And firstAddress <> fRange.Address
       
                For Each myRow In rowsToCopy
                    myInSht1.Range("C2:Y2").Copy
                    outCursor.PasteSpecial xlPasteAll
                    Application.CutCopyMode = False
                    Set outCursor = outCursor.Offset(1, 0)
                Next myRow
            End If
        End With
       
    ' Imports data from "Arming Roster" sheet, inputted by end users from the field
       
        'Looks for empty spaces in Column A (Last Name), then processes Column B (First Name)
        For Each cel In Columns(1)
            If IsEmpty(Columns(1)) Then
                Set outCursor = myOutSht.Range("Y" & Rows.Count).End(xlUp).Offset(1, 0)
               
                searchStr = "*"
               
                With myInSht2.Range("B2", myInSht2.Range("B" & Rows.Count).End(xlUp)) 'search to bottom of used range
               
                    Set fRange = .Find(what:=searchStr, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fRange Is Nothing Then
                        firstAddress = fRange.Address
                        Set rowsToCopy = fRange
                       
                        Do
                            Set fRange = .FindNext(fRange)
                            If Not fRange Is Nothing Then
                                Set rowsToCopy = Union(rowsToCopy, fRange)
                            End If
                        Loop While Not fRange Is Nothing And firstAddress <> fRange.Address
                       
                        For Each myRow In rowsToCopy
                            myInSht2.Range(Cells(myRow.Row, 1), Cells(myRow.Row, Columns.Count).End(xlToLeft)).Copy
                            outCursor.PasteSpecial xlPasteAll
                            Application.CutCopyMode = False
                            Set outCursor = outCursor.Offset(1, 0)
                        Next myRow
                    End If
                End With
               
            Else
            'If Column A isn't empty, it processes it instead of Column B
       
        Set outCursor = myOutSht.Range("Y" & Rows.Count).End(xlUp).Offset(1, 0)
               
                searchStr = "*"
               
                With myInSht2.Range("A2", myInSht2.Range("A" & Rows.Count).End(xlUp)) 'search to bottom of used range
               
                    Set fRange = .Find(what:=searchStr, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fRange Is Nothing Then
                        firstAddress = fRange.Address
                        Set rowsToCopy = fRange
                       
                        Do
                            Set fRange = .FindNext(fRange)
                            If Not fRange Is Nothing Then
                                Set rowsToCopy = Union(rowsToCopy, fRange)
                            End If
                        Loop While Not fRange Is Nothing And firstAddress <> fRange.Address
                       
                        For Each myRow In rowsToCopy
                            myInSht2.Range(Cells(myRow.Row, 1), Cells(myRow.Row, Columns.Count).End(xlToLeft)).Copy
                            outCursor.PasteSpecial xlPasteAll
                            Application.CutCopyMode = False
                            Set outCursor = outCursor.Offset(1, 0)
                        Next myRow
                    End If
                End With
       
            End If
        Next cel
       
   
    'Reformats the data in the "Contract" sheet back to the original orientation
        myInSht1.Activate
        Range("C1:D23").Value = WorksheetFunction.Transpose(Range("C1:Y2"))
        Range("E1:Y2").Delete
   
Else

      Set myOutSht = myWkb.Sheets(1)
      Set myInSht = ThatBook.Sheets(1)
       
       
    ' Imports data from "Master Arming Roster" sheet(s), inputted by various end users
       
        Set outCursor = myOutSht.Range("B" & Rows.Count).End(xlUp).Offset(1, -1)
       
        searchStr = "*"
       
        With myInSht.Range("B3", myInSht.Range("B" & Rows.Count).End(xlUp)) 'search to bottom of used range
       
            Set fRange = .Find(what:=searchStr, LookIn:=xlValues, lookat:=xlWhole)
            If Not fRange Is Nothing Then
                firstAddress = fRange.Address
                Set rowsToCopy = fRange
               
                Do
                    Set fRange = .FindNext(fRange)
                    If Not fRange Is Nothing Then
                        Set rowsToCopy = Union(rowsToCopy, fRange)
                    End If
                Loop While Not fRange Is Nothing And firstAddress <> fRange.Address
               
                For Each myRow In rowsToCopy
                    myInSht.Range(Cells(myRow.Row, 1), Cells(myRow.Row, Columns.Count).End(xlToLeft)).Copy
                    outCursor.PasteSpecial xlPasteAll
                    Application.CutCopyMode = False
                    Set outCursor = outCursor.Offset(1, 0)
                Next myRow
            End If
        End With
       
End If
   
   
    myOutSht.Range("E:E").NumberFormat = "m/d/yyyy"
    myOutSht.Range("F:F").NumberFormat = "m/d/yyyy"
    myOutSht.Range("P:P").NumberFormat = "m/d/yyyy"

ThatBook.Close

'perform a manual calculation since automatic was turned off earlier to improve speed
Application.Calculate

'turn the functions back on that were turned off earlier to improve speed
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
0
krishnakrkcCommented:
Hi,

Try

Kris
Public Mybook As Workbook
Public ThatBook As Workbook

Sub ImportData()

'turn off certain functions to speed up the processing
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim myWkb As Workbook
    Dim myInSht As Worksheet
    Dim myInSht1 As Worksheet
    Dim myInSht2 As Worksheet
    Dim myOutSht As Worksheet
    Dim fRange As Range, firstAddress As String
    Dim outCursor As Range
    Dim searchStr As String
    Dim rowsToCopy As Range, myRow As Range
    
        
    'user will be prompted to open the desired Arming Roster workbook
    
    Set Mybook = ActiveWorkbook
    Filename = Application.GetOpenFilename
    Workbooks.Open Filename:=Filename
    Set ThatBook = ActiveWorkbook
    Set myWkb = ThisWorkbook
    
    
    'This If/Then procedure differentiates between Arming Roster and Master Arming Roster as the Target Worksheet
        
    If ThatBook.Sheets(1).Name = "Arming Roster" Then
    
        Set myOutSht = myWkb.Sheets("Master Arming Roster")
        Set myInSht1 = ThatBook.Sheets("Contract")
        Set myInSht2 = ThatBook.Sheets("Arming Roster")
        
        
        'Reformats (transposes) "Contract" tab data so the code below can interact with it properly
    
        myInSht1.Activate
        Range("C1:Y2").Value = WorksheetFunction.Transpose(Range("C1:D23"))
        Range("C3:D23").Delete
        myInSht2.Activate
        
        'Imports data from "Contract" sheet, inputted by ACOs
        
        Set outCursor = myOutSht.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
        
        With myInSht2
            Set rowsToCopy = Intersect(.UsedRange, .Range("A2:B" & .UsedRange.Rows.Count)) 'search to bottom of used range
            If Not rowsToCopy Is Nothing Then
                For Each myRow In rowsToCopy
                    myInSht1.Range("C2:Y2").Copy
                    outCursor.PasteSpecial xlPasteAll
                     
                    ' Imports data from "Arming Roster" sheet, inputted by end users from the field
                    myInSht2.Range(myInSht2.Cells(myRow.Row, 1), myInSht2.Cells(myRow.Row, myInSht2.Columns.Count).End(xlToLeft)).Copy
                    outCursor.Offset(, 23).PasteSpecial xlPasteAll
                    
                    Application.CutCopyMode = False
                    Set outCursor = outCursor.Offset(1, 0)
                Next myRow
            End If
            
        End With
        
        'Reformats the data in the "Contract" sheet back to the original orientation
        myInSht1.Activate
        Range("C1:D23").Value = WorksheetFunction.Transpose(Range("C1:Y2"))
        Range("E1:Y2").Delete
    
    Else

        Set myOutSht = myWkb.Sheets(1)
        Set myInSht = ThatBook.Sheets(1)
        
        
        ' Imports data from "Master Arming Roster" sheet(s), inputted by various end users
        
        Set outCursor = myOutSht.Range("B" & Rows.Count).End(xlUp).Offset(1, -1)
        
        With myInSht.Range("B3", myInSht.Range("B" & Rows.Count).End(xlUp)) 'search to bottom of used range
            
            Set rowsToCopy = Intersect(.UsedRange, .Range("A3:B" & .UsedRange.Rows.Count)) 'search to bottom of used range
            
            If Not rowsToCopy Is Nothing Then
                
                For Each myRow In rowsToCopy
                    myInSht.Range(myInSht.Cells(myRow.Row, 1), myInSht.Cells(myRow.Row, myInSht.Columns.Count).End(xlToLeft)).Copy
                    outCursor.PasteSpecial xlPasteAll
                    Application.CutCopyMode = False
                    Set outCursor = outCursor.Offset(1, 0)
                Next myRow
            End If
        End With
        
    End If
    
    
    myOutSht.Range("E:E").NumberFormat = "m/d/yyyy"
    myOutSht.Range("F:F").NumberFormat = "m/d/yyyy"
    myOutSht.Range("P:P").NumberFormat = "m/d/yyyy"

    ThatBook.Close

    'perform a manual calculation since automatic was turned off earlier to improve speed
    Application.Calculate
    
    'turn the functions back on that were turned off earlier to improve speed
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

Open in new window

0
Learn SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

rjason137Author Commented:
Krishnakrkc,

Your code is much more elegant than mine. Thanks for the reply. I tried using your code and it is still doubling up on the people where both the first and last names are present. I want each row with data in it to be displayed only once on the output sheet. Everything else appears to be working well though.

Regards,
Jason
0
rjason137Author Commented:
... Oh, I also noticed that when I try to import one Master Arming Roster into another one, I get an error at Ln 86 of your code.
0
krishnakrkcCommented:
Hi

Replace the For Each myRow .... part with the following

Dim lngLoop     As Long

For lngLoop = 1 To rowsToCopy.Rows.Count
    myInSht1.Range("C2:Y2").Copy
    outCursor.PasteSpecial xlPasteAll
     
    ' Imports data from "Arming Roster" sheet, inputted by end users from the field
    myInSht2.Range(myInSht2.Cells(rowsToCopy.Row + lngLoop - 1, 1), myInSht2.Cells(rowsToCopy.Row + lngLoop - 1, myInSht2.Columns.Count).End(xlToLeft)).Copy
    outCursor.Offset(, 23).PasteSpecial xlPasteAll
   
    Application.CutCopyMode = False
    Set outCursor = outCursor.Offset(1, 0)
Next

Replace line # 84 with

With myInSht

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
rjason137Author Commented:
Hi Kris,

the first part seems to be working fine. For the 2nd part where I need to be able to import one Master Arming Roster into another, it is getting hung up on Ln 90:

Set rowsToCopy = Intersect(.UsedRange, .Range("A3:B" & .UsedRange.Rows.Count)) 'search to bottom of used range

I didn't understand what you were trying to convey in your last post at the end when you said:

Replace line # 84 with

With myInSht

In the last interation of code line 84 did begin with "With myInSht", so I'm not sure what you wanted me to change here.

Here is the latest iteration of the code as it stands right now:

Public Mybook As Workbook
Public ThatBook As Workbook

Sub ImportData()

'turn off certain functions to speed up the processing
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim myWkb As Workbook
    Dim myInSht As Worksheet
    Dim myInSht1 As Worksheet
    Dim myInSht2 As Worksheet
    Dim myOutSht As Worksheet
    Dim fRange As Range, firstAddress As String
    Dim outCursor As Range
    Dim searchStr As String
    Dim rowsToCopy As Range, myRow As Range
    
        
    'user will be prompted to open the desired Arming Roster workbook
    
    Set Mybook = ActiveWorkbook
    Filename = Application.GetOpenFilename
    Workbooks.Open Filename:=Filename
    Set ThatBook = ActiveWorkbook
    Set myWkb = ThisWorkbook
    
    
    'This If/Then procedure differentiates between Arming Roster and Master Arming Roster as the Target Worksheet
        
    If ThatBook.Sheets(1).Name = "Arming Roster" Then
    
        Set myOutSht = myWkb.Sheets("Master Arming Roster")
        Set myInSht1 = ThatBook.Sheets("Contract")
        Set myInSht2 = ThatBook.Sheets("Arming Roster")
        
        
        'Reformats (transposes) "Contract" tab data so the code below can interact with it properly
    
        myInSht1.Activate
        Range("C1:Y2").Value = WorksheetFunction.Transpose(Range("C1:D23"))
        Range("C3:D23").Delete
        myInSht2.Activate
        
        'Imports data from "Contract" sheet, inputted by ACOs
        
        Set outCursor = myOutSht.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
        
        With myInSht2
            Set rowsToCopy = Intersect(.UsedRange, .Range("A2:B" & .UsedRange.Rows.Count)) 'search to bottom of used range
            If Not rowsToCopy Is Nothing Then
                
                Dim lngLoop     As Long

                For lngLoop = 1 To rowsToCopy.Rows.Count
                    myInSht1.Range("C2:Y2").Copy
                    outCursor.PasteSpecial xlPasteAll
                     
                    ' Imports data from "Arming Roster" sheet, inputted by end users from the field
                    myInSht2.Range(myInSht2.Cells(rowsToCopy.Row + lngLoop - 1, 1), myInSht2.Cells(rowsToCopy.Row + lngLoop - 1, myInSht2.Columns.Count).End(xlToLeft)).Copy
                    outCursor.Offset(, 23).PasteSpecial xlPasteAll
                    
                    Application.CutCopyMode = False
                    Set outCursor = outCursor.Offset(1, 0)
                Next

            End If
            
        End With
        
        'Reformats the data in the "Contract" sheet back to the original orientation
        myInSht1.Activate
        Range("C1:D23").Value = WorksheetFunction.Transpose(Range("C1:Y2"))
        Range("E1:Y2").Delete
    
    Else

        Set myOutSht = myWkb.Sheets(1)
        Set myInSht = ThatBook.Sheets(1)
        
        
        ' Imports data from "Master Arming Roster" sheet(s), inputted by various end users
        
        Set outCursor = myOutSht.Range("B" & Rows.Count).End(xlUp).Offset(1, -1)
        
        With myInSht.Range("B3", myInSht.Range("B" & Rows.Count).End(xlUp)) 'search to bottom of used range
            
            Set rowsToCopy = Intersect(.UsedRange, .Range("A3:B" & .UsedRange.Rows.Count)) 'search to bottom of used range
            
            If Not rowsToCopy Is Nothing Then
                
                For Each myRow In rowsToCopy
                    myInSht.Range(myInSht.Cells(myRow.Row, 1), myInSht.Cells(myRow.Row, myInSht.Columns.Count).End(xlToLeft)).Copy
                    outCursor.PasteSpecial xlPasteAll
                    Application.CutCopyMode = False
                    Set outCursor = outCursor.Offset(1, 0)
                Next myRow
            End If
        End With
        
    End If
    
    
    myOutSht.Range("E:E").NumberFormat = "m/d/yyyy"
    myOutSht.Range("F:F").NumberFormat = "m/d/yyyy"
    myOutSht.Range("P:P").NumberFormat = "m/d/yyyy"

    ThatBook.Close

    'perform a manual calculation since automatic was turned off earlier to improve speed
    Application.Calculate
    
    'turn the functions back on that were turned off earlier to improve speed
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

Open in new window

0
rjason137Author Commented:
Kris,

Nevermind that last post. I threw my original code in for the last part and it everything works now.

Thanks for your help!

Jason
0
krishnakrkcCommented:
Hi

What I meant was replace the following line

With myInSht.Range("B3", myInSht.Range("B" & Rows.Count).End(xlUp))

with

With myInSht

Kris
0
rjason137Author Commented:
Kris,

I thought that this code was working, but after further examination it appears that it is not working correctly as it is looking for code in the entire rows and not just the 2 columns I mentioned. I have already awarded you the points on this post, so I re-posted in a new post. If you have any more ideas on how to refine the code to get this working, I have posted the new one under the following title: "Searching 2 columns to copy data once per row."
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.