Iron Man
Iron Man

Reputation: 849

Filter an Excel file with Excel 2007 VBA

So what I'm trying to achieve here is to filter a huge Excel file on a specific value and then only show the rows with those values. If possible, I would also like to copy and paste these into another workbook without overwriting any existing data. What I do is run a report from our database and export it as an Excel file which is named with a time stamp. There are 26 columns of data. Column B is my target for 'filtering'. The value is 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, or 12 (representing the month of the year). As an example, I would like to filter all the December data, copy it from the spreadsheet into another Master File workbook. If the copy part is not possible, I still would like the ability to hide any data that is not for December. Then, I would also need to unhide this data and filter out all data except for November (11). Any help will be greatly appreciated.

Upvotes: 0

Views: 169

Answers (1)

ChrisB
ChrisB

Reputation: 3205

This sounds like something you can do easily without a VBA script. Try using the Excel autofilter. Apply it to the columns (not just a range). You can then filter the results based on the month column to select a single month. To move that filtered data to a new workbook, select the range, change your selection to visible cells only (ALT + ;) copy the data, then paste it somewhere else.

You could do this programatically with VBA in Excel. Here's a script I found from user "Dan Wagner" VBA code to Filter data and create a new sheet and transfer data to it

Option Explicit
Sub BringItAllTogether()

Dim DataSheet As Worksheet, TransfersSheet As Worksheet
Dim DataRng As Range, CheckRng As Range, _
    TestTRANS As Range, TestTRSF As Range, _
    CopyRng As Range, PasteRng As Range

'make sure the data sheet exists
If Not DoesSheetExist("DataSheet", ThisWorkbook) Then
    MsgBox ("No sheet named ""DataSheet"" found, exiting!")
    Exit Sub
End If

'assign the data sheet, data range and check range
Set DataSheet = ThisWorkbook.Worksheets("DataSheet")
Set DataRng = DataSheet.Range("$A$1:$H$4630")
Set CheckRng = DataSheet.Range("$B$1:$B$4630")

'make sure that trans or trsf exists in the check range
Set TestTRANS = CheckRng.Find(What:="trans", LookIn:=xlValues, LookAt:=xlWhole)
Set TestTRSF = CheckRng.Find(What:="trsf", LookIn:=xlValues, LookAt:=xlWhole)
If TestTRANS Is Nothing And TestTRSF Is Nothing Then
    MsgBox ("Could not find ""trans"" or ""trsf"" in column B, exiting!")
    Exit Sub
End If

'apply autofilter and create copy range
With DataRng
    .AutoFilter Field:=2, Criteria1:="=*trsf*", Operator:=xlOr, Criteria2:="=*trans*"
End With
Set CopyRng = DataRng.SpecialCells(xlCellTypeVisible)
DataSheet.AutoFilterMode = False

'make sure a sheet named transfers doesn't already exist, if it does then delete it
If DoesSheetExist("Transfers", ThisWorkbook) Then
    MsgBox ("Whoops, ""Transfers"" sheet already exists. Deleting it!")
    Set TransfersSheet = Worksheets("Transfers")
    TransfersSheet.Delete
End If

'create transfers sheet
Set TransfersSheet = Worksheets.Add
TransfersSheet.Name = "Transfers"

'paste the copied range to the transfers sheet
CopyRng.Copy
TransfersSheet.Range("A1").PasteSpecial Paste:=xlPasteAll

End Sub

Public Function DoesSheetExist(SheetName As String, BookName As Workbook) As Boolean
    Dim obj As Object
    On Error Resume Next
    'if there is an error, sheet doesn't exist
    Set obj = BookName.Worksheets(SheetName)
    If Err = 0 Then
        DoesSheetExist = True
    Else
        DoesSheetExist = False
    End If
    On Error GoTo 0
End Function

Hope this helps!

Upvotes: 1

Related Questions