Free Microsoft Excel 2013
Quick Reference
Free Microsoft 2013 Quick Reference Guide

Free Microsoft Excel 2013 Quick Reference

Macro filter based on date criteria Results

Help! I've been struggling with this for the past few weeks, and I'm hoping one of y'all can help me get past this.

What the macro is supposed to do is to load the file (customer.xls), delete columns and rows of data that aren't needed, and then delete additional rows of data that can be excluded based on conditional criteria.

If I run the macro as a whole, it deletes all rows save for the header row and leaves the auto filter set to 'on'. This despite turning the autofilter off at the conclusion of each of the subs. If I comment out the portion at the top which calls the subs and run the subs individually, it works, but with each sub i have to go back to the spreadsheet and manually turn the autofilter off.

The command to turn the autofilter off is included in each of the subs, but for some reason it isn't doing it. I have included a sample of the data that I'm working with, and the macro I'm using. Thanks in advance.

Marcus

HTML Code: 
Sub LoadFile()
' LoadFile Macro
' Macro written 8/28/2007 by marcus
    Workbooks.Open Filename:= _
        "M:Schedule Initiative Documentscustomer.xls"
    Call DeleteRowsandColumns
    Call DeleteInactiveJobs
    Call DeleteJobStatusNEContract
    Call DeleteCType
    Call DeleteJobEndDate
    Call AddNewColumns

End Sub

Sub DeleteRowsandColumns()
' Delete Rows And Columns Macro
' Macro written 8/28/2007 by marcus
    Rows("1:20").Delete
    Columns("A:A").Delete
    Columns("B:H").Delete
    Columns("G:M").Delete
    Columns("H:N").Delete
    Columns("I:M").Delete
    Columns("P:W").Delete
    Columns("S:T").Delete
    Columns("U:V").Delete
End Sub

Sub DeleteInactiveJobs()
'   This Sub deletes all rows where Hidden is other than "N"

'   Remove any existing AutoFilters.
    ActiveSheet.AutoFilterMode = False
    
'   Show only (filter) Column T transactions by non Y entries.
    Columns("T").Select
    Selection.AutoFilter Field:=1, Criteria1:="<>N"
    
'   Hide Row 1 so it's NOT deleted by the next line of code.
    Rows("1").EntireRow.Hidden = True
    
'   Delete all rows that are NOT hidden.
    Columns("T").SpecialCells(xlCellTypeVisible).EntireRow.Delete
    
'   Remove AutoFilters
    ActiveSheet.AutoFilterMode = False
    
'   Unhide Row 1.
    Rows("1").EntireRow.Hidden = False
    
End Sub

Sub DeleteJobStatusNEContract()

'   This Sub deletes all rows where JobStatus is other than "Contract (2)"

'   Remove any existing AutoFilters.
    ActiveSheet.AutoFilterMode = False

'   Show only (filter) Column R transactions by non 2 entries.
    Columns("R").Select
    Selection.AutoFilter Field:=1, Criteria1:="<>2"

'   Hide Row 1 so it's NOT deleted by the next line of code.
    Rows("1").EntireRow.Hidden = True

'   Delete all rows that are NOT hidden.
    Columns("R").SpecialCells(xlCellTypeVisible).EntireRow.Delete

'   Remove AutoFilters
    ActiveSheet.AutoFilterMode = False

'   Unhide Row 1.
    Rows("1").EntireRow.Hidden = False

End Sub

Sub DeleteCType()
'   This Sub deletes all rows where CTYPE is = "N/A"

'   Remove any existing AutoFilters.
    ActiveSheet.AutoFilterMode = False

'   Show only (filter) Column R transactions by non 2 entries.
    Columns("G").Select
    Selection.AutoFilter Field:=1, Criteria1:="N/A"

'   Hide Row 1 so it's NOT deleted by the next line of code.
    Rows("1").EntireRow.Hidden = True

'   Delete all rows that are NOT hidden.
    Columns("R").SpecialCells(xlCellTypeVisible).EntireRow.Delete

'   Remove AutoFilters
    ActiveSheet.AutoFilterMode = False

'   Unhide Row 1.
    Rows("1").EntireRow.Hidden = False

End Sub

Sub DeleteJobEndDate()
'   This Sub deletes all rows where JobEnd Date <> " "

'   Remove any existing AutoFilters.
    ActiveSheet.AutoFilterMode = False

'   Show only (filter) Column S transactions by non Blank entries.
    Columns("S").Select
    Selection.AutoFilter Field:=1, Criteria1:="<> "

'   Hide Row 1 so it's NOT deleted by the next line of code.
    Rows("1").EntireRow.Hidden = True

'   Delete all rows that are NOT hidden.
    Columns("S").SpecialCells(xlCellTypeVisible).EntireRow.Delete

'   Remove AutoFilters
    ActiveSheet.AutoFilterMode = False

'   Unhide Row 1.
    Rows("1").EntireRow.Hidden = False

End Sub

Sub AddNewColumns()
'   This Sub Adds Columns U and V (CALC SVC DATE and NEXT SVC DATE)

    ActiveWindow.LargeScroll ToRight:=1
    Range("U1").Select
    ActiveCell.FormulaR1C1 = "CALC SVC DATE"
    Range("V1").Select
    ActiveCell.FormulaR1C1 = "NEXT SVC DATE"
    Range("W1").Select

End Sub


I realize that several people have asked about topics similar to my issue, and I have read many threads here and elsewhere but have not found a solution.

Since this site has a lot of resources, I have tried using them. Of most relevance were these two How Tos from this site:
Excel VBA: Delete Excel Rows Based on a Specified Condition or Criteria
How to use AutoFilters in Excel VBA Macros

The first article seemed like it would be exactly what I need, but the EntireRow.Delete call used in that example is the line that is generating my error.

In brief, I am opening two external files, copying some data from each into it's own tab of data in the original file, then for each set of pasted data, trying to delete any row that has "Obsolete" in the 8th column.

Here is a longer explanation of what I'm doing:
I have three files as part of the code:

The original file, which contains the macro
ProdFamily_Lookup: This tab is used by the user to enter a part number, and vlookups are performed on the other tabs to return a product familySAP_Dump: This tab is one set of lookup data that comes from the first file opened by the macro; the data is a named Table "SAP_Table"SAP_Dump_5xx: This tab is a second set of lookup data that comes from the second file opened by the macro; the data is a named Table "SAP5xx_Table"SAP_Dump.xlsx: This file contains the first set of lookup data that will be copied and pasted into the original file (one tab, named to the date the dump file was created)SAP_Dump_5xx.xlsx: This file contains the second set of lookup data that will be copied and pasted into the original file (one tab, named to the date the dump file was created)The basic steps in the macro are to, for each set of data to be copied/pasted:

Disable any existing AutoFilterCrop the Table of data (this is easier than deleting the table and recreating it each time)Open the external fileCopy the first 11 columns of dataPaste the copied data (paste values) starting in cell A2 (to maintain the table headers)Close the external fileFilter column 8 match a value of "Obsolete"Delete all visible rows of the filtered TableRemove the AutoFilterRepeat for the second set of data
The external files are quite large (5MB and 18MB respectively), so the macro will take a little while to run. The way the data is dumped, I can't just copy the entire tab from the external files because the data thinks that it extends to column "XFD" and is so large that Excel freaks out (someone else controls the data dump so I can't get this fixed). So I decided to just copy the columns I need and paste them into the lookup tabs.

Here is my code:

	VB:
	
 SAP_Dump_Refresh() 
     '
     ' SAP_Dump_Refresh Macro
     '
     
     '****************************************************************************************
     '**     Macro to update the two SAP Dump tabs from external Dump files                 **
     '****************************************************************************************
     
     '****************************************************************************************
     '**     Macro prep work:                                                               **
     '**       - define vatiables                                                           **
     '**       - tell the user the macro is running                                         **
     '**       - disable screen updates                                                     **
     '****************************************************************************************
     
    Dim wbSAP As Workbook 
    Dim wbSAP5xx As Workbook 
    Dim wbLookup As Workbook 
    Dim rSAPRange As Range 
    Dim rSAP5xxRange As Range 
     
    Set wbLookup = ThisWorkbook 
     
    Sheets("ProductFamily_Lookup").Activate 
    Range("WaitMsgCell").Select 
    ActiveCell.Formula = "Macro is updating, please wait..." 
     
     'Application.ScreenUpdating = False
     
     '****************************************************************************************
     '**     First prepare the file by cropping the existing tables which will be replaced  **
     '****************************************************************************************
     
    Sheets("SAP_Dump").Activate 
    ActiveSheet.AutoFilterMode = False 
    Range("7:7").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
     
    Sheets("SAP_Dump_5xx").Activate 
    ActiveSheet.AutoFilterMode = False 
    Range("7:7").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
     
     
     '****************************************************************************************
     '**     Next step is to open the two external files and for each:                      **
     '**      - copy/paste the first 11 columns of data                                     **
     '**        (the columns needed are Material [1] and Part Test Family [11])             **
     '**      - delete all rows with Obsolete in the Status [8] column                      **
     '****************************************************************************************
     
    Set wbSAP = Workbooks.Open("C:UsersjmengelDesktopReferenceSAP_Dump.xlsx", True, True) 
     
    wbSAP.Activate 
    ActiveSheet.AutoFilterMode = False 
    ActiveSheet.Range("A2:K2").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 
     
    wbLookup.Activate 
    Sheets("SAP_Dump").Activate 
    Range("A2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Application.CutCopyMode = False 
     
    wbSAP.Close savechanges:=False 
    wbLookup.Activate 
    Sheets("SAP_Dump").Activate 
     
    Set rSAPRange = ActiveSheet.Range("SAP_Table") 
    ActiveSheet.AutoFilterMode = False 
    With rSAPRange 
        .AutoFilter 
        .AutoFilter Field:=8, Criteria1:="Obsolete" 
         '************************************************************************************
         '********* This line causes run-time error '1004' delete method of range class failed
         '************************************************************************************
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete 
    End With 
    ActiveSheet.AutoFilterMode = False 
     
    Range("C2").Select 
     
    Set wbSAP5xx = Workbooks.Open("C:UsersjmengelDesktopReferenceSAP_Dump_5xx.xlsx", True, True) 
     
    wbSAP5xx.Activate 
    Range("A2:K2").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 
    wbLookup.Activate 
    Sheets("SAP_Dump_5xx").Select 
    Range("A2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Application.CutCopyMode = False 
     
    Set rSAP5xxRange = ActiveSheet.Range("SAP_5xx_Table") 
    ActiveSheet.AutoFilterMode = False 
    With rSAP5xxRange 
        .AutoFilter 
        .AutoFilter Field:=8, Criteria1:="Obsolete" 
         '************************************************************************************
         '********* This line causes run-time error '1004' delete method of range class failed
         '************************************************************************************
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete 
    End With 
    ActiveSheet.AutoFilterMode = False 
     
    Range("C2").Select 
     
    wbSAP5xx.Close savechanges:=False 
    wbLookup.Activate 
     
     
     '****************************************************************************************
     '**     Macro clean up:                                                                **
     '**       - remove the macro is running text                                           **
     '**       - return cursor to part number cell                                          **
     '**       - enable screen updates                                                      **
     '****************************************************************************************
     
    Sheets("ProductFamily_Lookup").Activate 
    Range("WaitMsgCell").Select 
    ActiveCell.Clear 
    Range("C2").Select 
    Application.ScreenUpdating = True 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
There are two problems that I'm noticing. The first, which is not a show-stopper, is that the ActiveSheet.AutoFilterMode = False is not turning off the AutoFilter. For debugging, I've commented out the ScreenUpdating = False call, so I can watch what is happening. At no time, on any of the tabs, does the AutoFilter actually turn off. This is not a major issue, but I mention it in case it is linked to the root cause of the second, more pressing problem.

The second problem is that the EntireRow.Delete call is causing a "run-time error '1004' delete method of range class failed" alarm. This was taken, almost directly, from the first How To link above.

It might be relevant that the data sets from which I am filtering and deleting rows are named Tables. If Tables need to be handled differently, that is probably what I'm doing wrong. I'm also not an expert at macros; I've tried researching this and have found many sggestions and have tried to implement them as I could. So if my code seems a little haphazard, that's why. Any insight into my issue (or even suggestions for more elegant methods/practices) would be appreciated.

~Jason

Hi All,

Firstly, this forum has been a great help to me learning VBA over the last couple of weeks, so thank-you to you all for your questions and answers.

I've run into a wall debugging my first large VBA project; Ive done a pretty thorough search, and while I found a few similar problems, none of the solutions have helped my particular error.

The code is designed to filter a large list of clients based on the value of the Activecell, which is in column F: containing Medical Practice names.

After filtering, the code creates a new sheet, pastes the filtered values there, and then starts to format them. This is where the problem occurs. I suspect it's due to the liberal use of "Active" sheets and books and cells throughout the code, but I can't be sure.

Here's the troublesome part, and I'll post the full code below. The debugger points to the first "If" line, line 7 of this sample.


	VB:
	
 
Set WSLoop = Sheets("New Patient List") 
WSNewRows = WSLoop.UsedRange.Count 
CellA = 4 
CellB = 4 
 
For CellA = 4 To WSNewRows 
    CellB = CellA + 1 
    If WSLoop.Range(Cells(CellB, 5)).Value = WSLoop.Range(Cells(CellA, 5)).Value Then 
        If WSLoop.Range(Cells(CellA, 5)).Interior.Colourindex = 35 Then 
            WSLoop.Range(Cells(CellB, 1), Cells(CellB, 6)).Interior.ColorIndex = 35 
        Else 
            WSLoop.Range(Cells(CellB, 1), Cells(CellB, 6)).Interior.ColorIndex = 34 
        End If 
    Else 
        If WSLoop.Range(Cells(CellA, 5)).Interior.Colourindex = 35 Then 
            WSLoop.Range(Cells(CellB, 1), Cells(CellB, 6)).Interior.ColorIndex = 34 
        Else 
            WSLoop.Range(Cells(CellB, 1), Cells(CellB, 6)).Interior.ColorIndex = 35 
        End If 
    End If 
Next CellA 
 
End If 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
The full code (minus some of the detailed comments from Mr De Bruin and myself; let me know if they would help) is thus:


	VB:
	
 
Sub GP_Filter_to_new_WS() 
     'Code by Ron de Bruin (last update 27-July-2010)
     'with modification and additions by Evan Tunbridge 13/5/2011
     
    Dim My_Range As Range 
    Dim ParentSheet As Worksheet 
    Dim ProviderName As Object 
    Dim WSNewRows As Integer 
    Dim WSLoop As Worksheet 
    Dim CellA As Integer 
    Dim CellB As Integer 
    Dim CalcMode As Long 
    Dim ViewMode As Long 
    Dim FilterCriteria As String 
    Dim CCount As Long 
    Dim WSNew As Worksheet 
    Dim sheetName As String 
    Dim rng As Range 
     
     'Remember the Active Worksheet, to unhide columns etc at the end
    Set ParentSheet = ActiveSheet 
     
     'Remember the Provider Name, it should be the active cell when the Macro starts
    Set ProviderName = ActiveCell 
     
    Set My_Range = Range("A3:H" & LastRow(ActiveSheet)) 
    My_Range.Parent.Select 
    If ActiveWorkbook.ProtectStructure = True Or _ 
    My_Range.Parent.ProtectContents = True Then 
        MsgBox "Sorry, not working when the workbook or worksheet is protected", _ 
        vbOKOnly, "Copy to new worksheet" 
        Exit Sub 
    End If 
     'Change ScreenUpdating, Calculation, EnableEvents, ....
    With Application 
        CalcMode = .Calculation 
        .Calculation = xlCalculationManual 
        .ScreenUpdating = False 
        .EnableEvents = False 
    End With 
    ViewMode = ActiveWindow.View 
    ActiveWindow.View = xlNormalView 
    ActiveSheet.DisplayPageBreaks = False 
     
     'Firstly, remove the AutoFilter
    My_Range.Parent.AutoFilterMode = False 
     
     'Filter and set the filter field and the filter criteria :
     'This line filter on the 6th column in the range (change the field if needed)
     'In this case the range starts in A so Field 1 is column A, 6 = column F, ......
     'My_Range.AutoFilter Field:=6, Criteria1:="=Dellwood Medical Centre"
     'If you want to filter on a cell value you can use this, use "" for the opposite
     
     'This line uses the "ProviderName" Variable, which we assigned the Active Cell to
    My_Range.AutoFilter Field:=6, Criteria1:="=" & ProviderName 
     
     'Now Hides the columns that should not be copied to the new sheet
     'to be sent to providers Such as dates notified, provider names, etc.
     
    ActiveSheet.Columns("F:G").Hidden = True 
    ActiveSheet.Columns("I:T").Hidden = True 
     
     'Check if there are not more then 8192 areas(limit of areas that Excel can copy)
    CCount = 0 
    On Error Resume Next 
    CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count 
    On Error Goto 0 
    If CCount = 0 Then 
        MsgBox "There are more than 8192 areas:" _ 
        & vbNewLine & "It is not possible to copy the visible data." _ 
        & vbNewLine & "Tip: Sort your data before you use this macro.", _ 
        vbOKOnly, "Copy to worksheet" 
    Else 
         'Add a new Worksheet
        Set WSNew = Worksheets.Add(After:=Sheets(ActiveSheet.Index)) 
        On Error Resume Next 
        WSNew.Name = "New Patient List" 
        If Err.Number > 0 Then 
            MsgBox "Change the name of sheet : " & WSNew.Name & _ 
            " manually after the macro is ready. The sheet name" & _ 
            " you fill in already exists or you use characters" & _ 
            " that are not allowed in a sheet name." 
            Err.Clear 
        End If 
        On Error Goto 0 
         
         'Copy/paste the visible data to the new worksheet
        My_Range.Parent.AutoFilter.Range.Copy 
        With WSNew.Range("A3") 
            .PasteSpecial Paste:=8 
            .PasteSpecial xlPasteValues 
            .PasteSpecial xlPasteFormats 
            Application.CutCopyMode = False 
            .Select 
        End With 
         
        With WSNew.Range("A1:F1") 
            .MergeCells = True 
            .Value = ProviderName & " - Current Patients" 
            .HorizontalAlignment = xlCenter 
            .VerticalAlignment = xlCenter 
            .Font.Size = 18 
            .Font.Name = "Arial" 
            .Interior.Color = RGB(192, 192, 192) 
        End With 
         
         
         'Applying finishing touches to the New Patient List sheet;
         'including formatting, heading, etc
         
         'Sets first row of data fill as Light Green
        WSNew.Range("A4:F4").Interior.ColorIndex = 35 
         
         'The below lines format the pasted data values based on the addresses (Col F of new sheet);
         'They test if the second entry's address (F5) is the same as the one above it
         'and if it is, gives it the same colour. If its different, then gives it
         'another colour. This repeats for all subsequent rows.
         
        Set WSLoop = Sheets("New Patient List") 
        WSNewRows = WSLoop.UsedRange.Count 
        CellA = 4 
        CellB = 4 
         
        For CellA = 4 To WSNewRows 
            CellB = CellA + 1 
            If WSLoop.Range(Cells(CellB, 5)).Value = WSLoop.Range(Cells(CellA, 5)).Value Then 
                If WSLoop.Range(Cells(CellA, 5)).Interior.Colourindex = 35 Then 
                    WSLoop.Range(Cells(CellB, 1), Cells(CellB, 6)).Interior.ColorIndex = 35 
                Else 
                    WSLoop.Range(Cells(CellB, 1), Cells(CellB, 6)).Interior.ColorIndex = 34 
                End If 
            Else 
                If WSLoop.Range(Cells(CellA, 5)).Interior.Colourindex = 35 Then 
                    WSLoop.Range(Cells(CellB, 1), Cells(CellB, 6)).Interior.ColorIndex = 34 
                Else 
                    WSLoop.Range(Cells(CellB, 1), Cells(CellB, 6)).Interior.ColorIndex = 35 
                End If 
            End If 
        Next CellA 
         
    End If 
     
     'Close AutoFilter, unhide the columns on the starting Worksheet
    My_Range.Parent.AutoFilterMode = False 
    ParentSheet.Columns("F:G").Hidden = False 
    ParentSheet.Columns("I:T").Hidden = False 
     
     'Restore ScreenUpdating, Calculation, EnableEvents, ....
    My_Range.Parent.Select 
    ActiveWindow.View = ViewMode 
    If Not WSNew Is Nothing Then WSNew.Select 
    With Application 
        .ScreenUpdating = True 
        .EnableEvents = True 
        .Calculation = CalcMode 
    End With 
     
End Sub 
 
Function LastRow(sh As Worksheet) 
    On Error Resume Next 
    LastRow = sh.Cells.Find(What:="*", _ 
    After:=sh.Range("A1"), _ 
    Lookat:=xlPart, _ 
    LookIn:=xlValues, _ 
    SearchOrder:=xlByRows, _ 
    SearchDirection:=xlPrevious, _ 
    MatchCase:=False).Row 
    On Error Goto 0 
End Function 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Let me know if I can provide any other details or information. If it would help, I'll try to put together a dummy spreadhseet that duplicates the format and data of the sheets I'm working with; I cant really send the sheet, as it contains names and addresses, etc.

Thanks in advance!

I need a new formula that looks at a couple of criterias before calculating.

This is a spreadsheet I developed for work, it helps me track my time and estimated times for projects. (See Attached Spreadsheet)

column explanations
A7-A11 are the estimates for my projects on a weekly bases.
B7-B11 are my Project #s.
C7-C11 are formulas that display how much estimated project is left. D7-D11 displays any overtime I needed on a project.

G3-G9 display the weekday totals.
I3-I7 display the weekly project time.
J4, J6, and J8 display miscellaneous project time totals.

Rows 15 and below is where I store my data.

My new feature: M2

This area will total up the amount of time spent on a project for each day.
This will save me time when inputing my data in the official tracking system, b/c I won't have to filter and add up times.

My new Problem: I need a formula that looks at A15-A90 (the date), and then looks at the Project # (H15-H90) and adds the Hours (B15-B90).

Expected:
The expected results should be a total number of hours for each day per project.

Thanks in advance for your help.

Sample Attached.

Also a manual task I must perform each week is modifying the dates in G3-G9 to reflect the current week, is there a formula that will automatically update the dates for me? and, I hate to be too picky but I back these up at the beginning of the new week (copying entire worksheet to another worksheet and delete the data and change the dates of the original), so I would need a formula or macro that I could run a to update to the current week, an persistant formula would also update my history saves.

Again, your help and expertise is greatly appreciated.

EDIT: I have edited the subject title for you - jiuk

I'm wanting to use the below routine to copy data from one spreadsheet and paste into another, below any existing date, based on autofilter results. The code I'm using is derived from another use, and I'm fairly confident parts of it will work, other than choosing the step, the error handling section, and pasting below existing data.

What I WANT to happen is this:
User selects Step 1.
Macro says to itself "A-ha! Step 1! I need to do this routine for Step 1"
(There are about 10 steps, each one requiring a different function, so any help I can get on that part would be greatly appreciated).

Macro applies autofilter to data in sheet "Data". If the criteria ("0") exists, then all the visible cells need to be copied and pasted to a "Results" tab, underneath any existing lines, preferably noted somehow as "Step 1 Results".

If the criteria ("0") doesn't exist, I want a MsgBox to say something like "Step1 passed with no exceptions" and then paste that same message to to the same worksheet it would have pasted the visible cells to. Ideally at the end of all the steps I'll print up a report card of what steps passed, and what exceptions (ie: criteria DOES exist) need to further researched.

My code is below. At this point in the program the user has selected what regions he wants to look at, and has decided what Step he wants to do next. Both the Region and the Step are pasted into cells in the "Steps" worksheets, and the data to examine are in the "Data" worksheet.

Dim CurStep As Range
  Dim DstWkb As Workbook
  Dim i As Long, j As Long
  Dim Rng As Range
  Dim RngEnd As Range
    
  'Initialize the workbook object variables
    Set DstWkb = Workbooks("Final.xls")

'Setup the range to look in to compare values
    Set CurStep = DstWkb.Worksheets("Steps").Range("E2")
         
    For Each cell In CurStep
     'Validate cell contents
      Select Case cell.Text
        Case Is = "Step 1", "Step 2", "Step 3", etc. 
       
         'Restrain the filter to cells from A1 to the last entry in column W
          With DstWkb.Worksheets("Data")
            Set Rng = .Range("A1:W1")
            Set RngEnd = .Cells(Rows.Count, Rng.Column).End(xlUp)
            Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, .Range(Rng, RngEnd))
          End With

         'Filter the data using column M
          Rng.EntireRow.Autofilter Field:=13, Criteria1:= ("0")

         'Trap the error if there were no matches
          On Error Resume Next

           'Copy only the filtered data
           Range("J1").Activate
        Rng.SpecialCells(xlCellTypeVisible).Copy _
                Destination:=DstWkb.Worksheets("Results").Range("A1")

         'Clear the error if there was one
          Err.Clear
         'Return error control back to the system
          On Error GoTo 0

      End Select
    Next


Hi Gurus,

I am posting thread after long time. Here is my need, i have 3 extracted CSV Files, in that files i want a range by giving dates and also with criteria having Filtered groups. finally paste that 3 CSV files into single XL workbook with different sheets with names which having macro. I believe my question is more understandable. I couldn’t attach sheets here. Based on my question u can able to judge my query and resolve this..

note: whenever i run the macro, it should automatically search the CSV files in the locations, deleting the existing sheets in the macro.xls and adding new sheets with the name file name

Advance thanks.


No luck finding an answer? You could always try Google.