VBA Search a table header row filter & copy used range

Bagsy

Active Member
Joined
Feb 26, 2005
Messages
377
Office Version
365
Platform
Windows
I hope somebody can help me a bit please.
I am attempting to put some code together to search for a name in a header row of a table, filter that column non blank cells. But it needs to filter the whole table.
I have the code working up to the point where it searches the header rows and finds the name
But I am struggling to get filter and copy to work.
I need the whole table filtered because I am eventually trying to achieve as follows
• Search for a name in a table in Sheets("Collated Data")
• Filter & copy the used range in found column (this is day or ½ day holiday)
• Paste onto an employee holiday allocation sheet
• Come back to the table in Sheets("Collated Data")
• Copy column D used range (these are the holiday dates)
• Paste this on the same holiday allocation sheet
At the moment I cannot get passed the filter and copy stage to work on the rest of the code
Any help is very much appreciated




Code:
Sub Addholidays()
Dim WB As Workbook
Dim CurrentSheet As Worksheet
Set CurrentSheet = ActiveSheet
Dim Sh As Worksheet
Dim Locate As Range
Dim Name As String
'store Name value???
Dim Found As Boolean

Ans = MsgBox("Have you selected the correct employee name", vbYesNo)
If Ans = vbNo Then Exit Sub

Application.ScreenUpdating = False

'On Error GoTo ErrorHandler

Sheets("Planner").Select
    Name = ActiveCell.Value
        Sheets("Collated Data").Visible = True
            Sheets("Collated Data").Select
        Range("D4").Select 'select the first line of data in range D4:BP4
    Found = False ' Set Boolean variable "found" to false.
Do Until IsEmpty(ActiveCell) ' Set Do loop to stop at empty cell.

If ActiveCell.Value = Name Then ' Check active cell for search value.
    Found = True
        Exit Do
    End If
ActiveCell.Offset(0, 1).Select ' Step over 1 column from present location.
Loop
 
If Found = True Then ' Checked for found.

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx below this line not working yet
Range("Name").AutoFilter.Column , Criteria1:="<>"  'filter the whole table from found name column, non-blank cells. Table range (D4:BP370 including header row)
Range("Name").Copy.UsedRange  'copy all non blank cells in filtered used range below found name
End If
 

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,791
Office Version
365
Platform
Windows
Is your table a structured table, or just normal data?
If it's a structured table, what is its name?
 
Last edited:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,791
Office Version
365
Platform
Windows
If it is a structured table try
Code:
Sub Bagsy()
   Dim Nme As String
   
   Nme = Sheets("Planner").Range("[COLOR=#ff0000]A2[/COLOR]").Value
   With Sheets("Collated Data").ListObjects("[COLOR=#0000ff]table1[/COLOR]")
      .DataBodyRange.AutoFilter
      .DataBodyRange.AutoFilter .ListColumns(Nme).Index, "<>"
      .ListColumns(Nme).DataBodyRange.Copy Sheets("Planner").Range("[COLOR=#ff0000]C2[/COLOR]")
      .ListColumns(1).DataBodyRange.Copy Sheets("Planner").Range("[COLOR=#ff0000]B2[/COLOR]")
   End With
End Sub
Change input & output ranges to suit, along with table name.
 
Last edited:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,791
Office Version
365
Platform
Windows
If it's just normal data try
Code:
Sub Bagsy2()
   Dim Fnd As Range
   Dim Nme As String
   
   Nme = Sheets("Planner").Range("[COLOR=#ff0000]A2[/COLOR]").Value
   With Sheets("[COLOR=#ff0000][/COLOR]Collated Data")
      If .AutoFilterMode Then .AutoFilterMode = False
      Set Fnd = .Range("D4:BP4").Find(Nme, , , xlWhole, , , False, , False)
      .Range("D4:BP4").AutoFilter Fnd.Column - 3, "<>"
      .AutoFilter.Range.Offset(1).Columns(Fnd.Column - 3).Copy Sheets("Planner").Range("[COLOR=#ff0000]C2[/COLOR]")
      .AutoFilter.Range.Offset(1).Columns(1).Copy Sheets("Planner").Range("[COLOR=#ff0000]B2[/COLOR]")
   End With
End Sub
Once again change ranges to suit.
 

Bagsy

Active Member
Joined
Feb 26, 2005
Messages
377
Office Version
365
Platform
Windows
Thanks Fluff appreciate your assistance
This is just a normal table of data
I have copied your code and changed Nme as Activecell .value, which of gave me an error as below

What I am trying to achieve is select a cell with a name in it in sheets(”Planner”) ActiveCell.Value
1. Then go sheet “Collated data” find the ActiveCell.Value in the header row (Range D4:BP4)
2. Then and filter the whole table by that columns non-blank cells. & copy the filtered data in found column only.
3. Then I am trying to get the code to search the entire workbook (Except sheets “Macros”, “Planner”, “Collated Data”, “Bank Holidays”) in Cell (“E15”) for the name from the ActiveCell. Value and select this sheet
4. Then paste the found column filtered data onto the found sheet in column(“F26”)
5. Then go back to sheet “Collated data” and copy the filtered range in header row (“D4”)
6. Then go back to the found sheet and paste this data in column (“C26”)
7. Lastly remove filter from data in sheet “Collated Data”, hide sheet “Collated data” and select Sheet “Planner”

This all looks so easy when its listed like this, but all I managed to achieve was getting the code to find the name in the header row on "Collated Data" sheet

Tried this, gave me an error “Object does not support this property or method” on line 1

Code:
Sub Bagsy2()
   Dim Fnd As Range
   Dim Nme As String
   
   Nme = Sheets("Planner").ActiveCell.Value
   With Sheets("Collated Data")
      If .AutoFilterMode Then .AutoFilterMode = False
      Set Fnd = .Range("D4:BP4").Find(Nme, , , xlWhole, , , False, , False)
      .Range("D4:BP4").AutoFilter Fnd.Column - 3, "<>"
      .AutoFilter.Range.Offset(1).Columns(Fnd.Column - 3).Copy Sheets("Planner").Range("C2")
      .AutoFilter.Range.Offset(1).Columns(1).Copy Sheets("Planner").Range("B2")
   End With
End Sub
Tried this where I selected a cell with a name in it, gave me this error “Object variable with block variable not set” line 5

Code:
Sub Bagsy3()
   Dim Fnd As Range
   Dim Nme As String
   
   Nme = Sheets("Planner").Range("C6").Value
   With Sheets("Collated Data")
      If .AutoFilterMode Then .AutoFilterMode = False
      Set Fnd = .Range("D4:BP4").Find(Nme, , , xlWhole, , , False, , False)
      .Range("D4:BP4").AutoFilter Fnd.Column - 3, "<>"
      .AutoFilter.Range.Offset(1).Columns(Fnd.Column - 3).Copy Sheets("Planner").Range("C2")
      .AutoFilter.Range.Offset(1).Columns(1).Copy Sheets("Planner").Range("B2")
   End With
End Sub
This is my code, below the string of xxxxxxxxxxxxxxx not working yet, couldn’t get past the copy & paste
Code:
Sub Addholidays()
Dim WB As Workbook
Dim CurrentSheet As Worksheet
Set CurrentSheet = ActiveSheet
Dim sh As Worksheet
Dim Locate As Range
Dim Name As String
'store Name value???
Dim Found As Boolean

Sheets("Planner").Select
Name = ActiveCell.Value
Ans = MsgBox("Have you selected the correct employee name " & ActiveCell.Value, vbYesNo)
If Ans = vbNo Then Exit Sub

Application.ScreenUpdating = False

'On Error GoTo ErrorHandler

Sheets("Planner").Select
    Name = ActiveCell.Value
        Sheets("Collated Data").Visible = True
            Sheets("Collated Data").Select
        Range("D4").Select 'select the first line of data in range D4:BP4
    Found = False ' Set Boolean variable "found" to false.
Do Until IsEmpty(ActiveCell) ' Set Do loop to stop at empty cell.

If ActiveCell.Value = Name Then ' Check active cell for search value.
    Found = True
        Exit Do
    End If
ActiveCell.Offset(0, 1).Select ' Step over 1 column from present location.
Loop
 
If Found = True Then ' Checked for found.
ActiveCell.Select

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx below this line not working yet

'Range("Name").AutoFilter.Column , Criteria1:="<>"  'filter the whole table from found name column, non-blank cells. Table range (D4:BP370 including header row)
'Range("Name")(1, 0).Copy.UsedRange  'copy all non blank cells in filtered used range bellow found name

'ActiveSheet.Range("ActiveCell").AutoFilter.Column , Criteria1:="<>"
'ActiveCell.CurrentRegion.AutoFilter Field:=ActiveCell.CurrentRegion.Columns.Count - ActiveCell.Column + 1, Criteria1:="<>"
ActiveCell.AutoFilter Field:=ActiveCell.Column, Criteria1:="<>"




End If



' This part of the code is to seach the workbook for the employee holiday sheet (there name is in Cell (E15)
'For Each Sh In ThisWorkbook.Worksheets ' search through the workbook for the active cell value employee holiday sheet
'    With Sh.Range("E15") ' seach in cell "E15" for the active cell value
'        Set Locate = .Cells.Find(What:="Name.Value")
'            If Not Locate Is Nothing Then
'                Do Until Locate Is Nothing
'                    Sh.Select
'                Range("G26").PasteSpecial.xlValues ' pasting the values from Range x from the filtered table on collated data
'            Loop
'        End If
'    End With
'Set Locate = Nothing
'
'Next
'Sheets("Collated Data").Select ' going back to the filtered table in collated data
'    Range("D5").Copy.UsedRange ' range D4 is the header offset 1 row to copy filtered used range in the table
'        Worksheets("Collated Data").ShowAllData ' Reset filters
'            Sh.Select ' going back to the previous sheet (employee holiday sheet)
'    Range("C26").PasteSpecial.xlValues ' pasting the holiday dates Range D5 from the filtered table on collated data
'Range(x).AutoFilter , Criteria1:="<>"
'Sheets("Collated Data").Visible = False


'End If
'MyValue = Range("E15").Value

'MsgBox "Holiday sheet has been updated for " & Worksheets.Range("E15")
'MsgBox "Holiday sheet has been updated for  " & Range("E15").Value


Sheets("Planner").Select
Application.ScreenUpdating = False

Exit Sub
ErrorHandler: MsgBox ("Sheet for this employee has not been created."), , "Check Sheet"
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,791
Office Version
365
Platform
Windows
Make sure that the Planner sheet is the active sheet & try
Code:
Sub Bagsy2()
   Dim Fnd As Range
   Dim Nme As String
   
   Nme = ActiveCell.Value
   With Sheets("Collated Data")
      If .AutoFilterMode Then .AutoFilterMode = False
      Set Fnd = .Range("D4:BP4").Find(Nme, , , xlWhole, , , False, , False)
      .Range("D4:BP4").AutoFilter Fnd.Column - 3, "<>"
      .AutoFilter.Range.Offset(1).Columns(Fnd.Column - 3).Copy Sheets("Planner").Range("C2")
      .AutoFilter.Range.Offset(1).Columns(1).Copy Sheets("Planner").Range("B2")
      .AutoFilterMode = False
   End With
End Sub
 

Bagsy

Active Member
Joined
Feb 26, 2005
Messages
377
Office Version
365
Platform
Windows
Thanks Fluff
Tried running your code
Planner Sheet is definitely selected
It gives me the error “object variable or block variable not set” Line 5
When I hover over Nme the Name in the Activecell appears so it picking that up ok
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,791
Office Version
365
Platform
Windows
When you say Line 5, which line is that?
 

Bagsy

Active Member
Joined
Feb 26, 2005
Messages
377
Office Version
365
Platform
Windows
Hi Fluff, appreciate you taking your time to help
This line
.Range("D4:BP4").AutoFilter Fnd.Column - 3, "<>"
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,791
Office Version
365
Platform
Windows
Sounds like it cannot find the search value in D4:BP4.
Are you looking for a full or partial match?
 

Watch MrExcel Video

Forum statistics

Threads
1,099,255
Messages
5,467,573
Members
406,543
Latest member
semoredhawk

This Week's Hot Topics

Top