chxrlotter
chxrlotter

Reputation: 11

How to search the same column for more than one value?

I have a workbook which has eight worksheets. The first sheet is a front page which holds all the data within the workbook, a master sheet if you will. The remaining seven tabs are the staff names of the team.

I have code which will search column C for a name and copy the entire row containing that name into the corresponding staff member's individual worksheet.

I now need to search the same column (C) for the remaining staff members' names and copy the respective row to the respective worksheet.

My current code:

Private Sub CommandButton1_Click()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Front Page")
    Set Target = ActiveWorkbook.Worksheets("Charlotte")
    j = 2
    ' Start copying to row 2 in target sheet
    For Each c In Source.Range("C1:C1000") ' Do 1000 rows
        If c = "Charlotte Richardson" Then
            Source.Rows(c.Row).Copy Target.Rows(j)
            j = j + 1
        End If
    Next c
End Sub

Upvotes: 1

Views: 83

Answers (3)

VBasic2008
VBasic2008

Reputation: 55073

An Array Solution

It is strongly recommended that you create a copy of the original file and test the code there first. Open the workbook and go to SaveAs and save it with another name¸like 'Test' or something. Now you're ready to 'play'.

Before using this code you will have to manually input the data in the 'Customize' section of the code.

Such a code should ideally preserve old data in the seven sheets and update only (add new rows) but it always deletes (ClearContents) the old data in the seven sheets starting from row 2, before adding the new data. Further more, the code has no error handling.

On the other hand, the code does what it is supposed to do. If something would go wrong the 'Front Page' sheet is in no danger, so if something happens to the other sheets you can always create them again.

Private Sub CommandButton1_Click()
  Dim c As Range
  Dim i As Integer
  Dim j As Integer
  Dim Source As Worksheet
  Dim Target As Worksheet
  Dim arr() As String
  'Create an array of data
  ReDim arr(1 To 7, 1 To 2) As String
'-- Customize BEGIN --------------------
  'Sheet Names
  arr(1, 1) = "Charlotte"
  arr(2, 1) = ""
  arr(3, 1) = ""
  arr(4, 1) = ""
  arr(5, 1) = ""
  arr(6, 1) = ""
  arr(7, 1) = ""
  'Names in column 'C'
  arr(1, 2) = "Charlotte Richardson"
  arr(2, 2) = ""
  arr(3, 2) = ""
  arr(4, 2) = ""
  arr(5, 2) = ""
  arr(6, 2) = ""
  arr(7, 2) = ""
'-- Customize END ----------------------

  Set Source = ActiveWorkbook.Worksheets("Front Page")

  For i = 1 To 7
    j = 2
    Set Target = ActiveWorkbook.Worksheets(arr(i, 1))
    ' ClearContents of Target
    Target.Range(j & ":" & Target.Rows.Count).ClearContents
    ' Start copying to row 2 in target sheet
    For Each c In Source.Range("C1:C1000") ' Do 1000 rows
      If c = arr(i, 2) Then
        Source.Rows(c.Row).Copy Target.Rows(j)
        j = j + 1
      End If
    Next
  Next
End Sub

To fully understand the code you should read about arrays, loops, ranges and whatever keyword you see in the code.

Upvotes: 1

Frank Ball
Frank Ball

Reputation: 1126

If you were to name your sheets with the exact name you're looking for ("Charlotte Richardson", instead of "Charlotte"), then you could use this:

Private Sub CommandButton1_Click()
  Dim c As Range
  Dim j As Integer, i As Integer
  Dim Source As Worksheet

  Set Source = ActiveWorkbook.Worksheets("Front Page")
  For i = 2 To ActiveWorkbook.Sheets.Count 'Assuming that "Front Page" is your first sheet
    j = 2
    ' Start copying to row 2 in target sheet
    For Each c In Source.Range("C1:C1000") ' Do 1000 rows
      If c.Value2 = ActiveWorkbook.Worksheets(i).Name Then
        Source.Rows(c.Row).Copy ActiveWorkbook.Worksheets(i).Rows(j)
        j = j + 1
      End If
    Next c
  Next
End Sub

The nice thing about this is that when you have to add staff members all you have to do is add a new sheet with the correct name and your code will work without any modifications.

Upvotes: 1

dwirony
dwirony

Reputation: 5450

Try this - although you'll have to add the worksheet names to the array arr1 and the full names you're looking for to the array arr2:

Private Sub CommandButton1_Click()

    Dim c As Range
    Dim j As Long, i as Long
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim arr1 As Variant, arr2 As Variant

    arr1 = Array("Charlotte", "Mikey", "Bob")
    arr2 = Array("Charlotte Richardson", "Mikey Joe", "Bob Vann")

    'Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Front Page")

    'Start copying to row 2 in target sheet
    For i = 0 To UBound(arr1)

        j = 2
        Set Target = ActiveWorkbook.Worksheets(arr1(i))

        For Each c In Source.Range("C1:C1000") ' Do 1000 rows
            If c = arr2(i) Then
                Source.Rows(c.Row).Copy Target.Rows(j)
                j = j + 1
            End If
        Next c

    Next i

End Sub

Upvotes: 1

Related Questions