help with macro - creating new columns/copying/creating new worksheets from default

it would help if you uploaded the workbook, or a representative sample, together with details about what columns have changed and how ... have you inserted columns, deleted columns, changed the headings, etc? Ideally, a before and after (current) copy.

It's difficult to check the working without the structure and some typical data, and it's even harder to make that up.

I'm guessing that you recorded this macro as you undertook whatever the task was and you've just repeated it each time since. Yes?

Regards

Originally Posted by TMShucks

it would help if you uploaded the workbook, or a representative sample, together with details about what columns have changed and how ... have you inserted columns, deleted columns, changed the headings, etc? Ideally, a before and after (current) copy.

It's difficult to check the working without the structure and some typical data, and it's even harder to make that up.

I'm guessing that you recorded this macro as you undertook whatever the task was and you've just repeated it each time since. Yes?

Regards

Hi, this macro just gets repeated , when the xls is generated the data is different and macro is run against it. i uploaded the xls that is generated and the macro should be run against.

Sorry it's taken a while to reply; I've spent some time working on your current code.

With regard to filtering based on the column headings, one approach is the following function which will accept a column header and a range and return a column number using the MATCH function.

Function fMatchCol(sSearch As String, rSearchRange As Range) As Long
' UDF to find filter column based on column header
Dim AWF As WorksheetFunction
Set AWF = Application.WorksheetFunction
Dim lMatchCol As Long
lMatchCol = 0
On Error Resume Next
lMatchCol = AWF.Match(sSearch, rSearchRange, 0)
On Error GoTo 0
fMatchCol = lMatchCol
End Function

The subroutine following is a simple test of the function:

Private Sub TestMatch()
' Test fMatchCol function
Debug.Print fMatchCol("Creator Company", Rows("1:1"))
MsgBox fMatchCol("Creator Company", Rows("1:1"))
End Sub

An example of how this is used:

' Filter on Column 7 (G) = Due By
lFilterField1 = fMatchCol("Due By", Rows("1:1"))
With Rows("1:1")
    If Not ActiveSheet.AutoFilterMode Then
        .AutoFilter
    End If
    .AutoFilter _
        Field:=lFilterField1, _
        Criteria1:=">07/12/2010 0:00", _
        Operator:=xlAnd, _
        Criteria2:="<07/19/2010 0:00"
End With

As I said, I've amended the code; see below. I have removed all the scrolling and most of the selecting and generally tidied it up. I have adjusted the filter columns where it was, or seemed, obvious but I couldn't guess at some of them.

Finally, rather than hard coding dates in the body of the code, I would put them on a "control sheet" and initialise variables as the first stage of the macro execution. Alternatively, you could define some variables at the beginning (top) of your code and change the values there once. That would save ploughing through all the code ... too easy to miss something.

The comments serve to "self document" the code

Hope this helps.

Regards

'
' Amended code
'

Sub Test()
'
' Improved/amended code
'
' help with macro - creating new columns/copying/creating new worksheets from default
' http://www.excelforum.com/excel-prog...m-default.html
'

Dim lFilterField1 As Long
Dim lFilterField2 As Long

Debug.Print "Test Start " & Now()
Application.ScreenUpdating = False

' Step 1 - Filter and copy
' Filter on Column 13 (M) = Creator Company
lFilterField1 = fMatchCol("Creator Company", Rows("1:1"))
With Rows("1:1")
    If Not ActiveSheet.AutoFilterMode Then
        .AutoFilter
    End If
    .AutoFilter _
        Field:=lFilterField1, _
        Criteria1:="=GE*", _
        Operator:=xlAnd, _
        Criteria2:="<>GE Energy - Hydro"
End With
Cells.Copy

' Step 2 - Create new sheet (Default Data)
Sheets.Add.Name = "Default Data"
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:AZ").ColumnWidth = 20

' Step 3 - Delete original data
' Note *** commented out for testing purposes ***
' Worksheets("Default").Delete

' Step 4 - Filter and copy (Default Data)
' Filter on Column 7 (G) = Due By
lFilterField1 = fMatchCol("Due By", Rows("1:1"))
With Rows("1:1")
    If Not ActiveSheet.AutoFilterMode Then
        .AutoFilter
    End If
    .AutoFilter _
        Field:=lFilterField1, _
        Criteria1:=">07/12/2010 0:00", _
        Operator:=xlAnd, _
        Criteria2:="<07/19/2010 0:00"
End With
Cells.Copy

' Step 5 - Create new sheet (Percent OT)
Sheets.Add.Name = "Percent OT"
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:AZ").ColumnWidth = 20
' Filter on Column 16 (P) = Delta (in days)
lFilterField1 = fMatchCol("Delta (in days)", Rows("1:1"))
With Rows("1:1")
    If Not ActiveSheet.AutoFilterMode Then
        .AutoFilter
    End If
    .AutoFilter _
        Field:=lFilterField1, _
        Criteria1:="<=0", _
        Operator:=xlAnd
End With

' Step 6 - Filter and copy (Default Data)
Sheets("Default Data").Select
' Filter on Column 5? (?) = ?
' Filter on Column 7 (G) = Due By
lFilterField1 = fMatchCol("x?x", Rows("1:1"))
lFilterField1 = 5   ' on the basis I have no idea what should be filtered
lFilterField2 = fMatchCol("Due By", Rows("1:1"))
With Rows("1:1")
    If Not ActiveSheet.AutoFilterMode Then
        .AutoFilter
    End If
    .AutoFilter _
        Field:=lFilterField1, _
        Criteria1:="<>c", _
        Operator:=xlAnd
    .AutoFilter _
        Field:=lFilterField2, _
        Criteria1:="<07/19/2010", _
        Operator:=xlAnd
End With
Cells.Copy

' Step 7- Create new sheet (Overdue)
Sheets.Add.Name = "Overdue"
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:AZ").ColumnWidth = 20
Rows("1:1").AutoFilter
Range("R2").Sort _
    Key1:=Range("R2"), _
    Order1:=xlDescending, _
    Header:=xlGuess, _
    OrderCustom:=1, _
    MatchCase:=False, _
    Orientation:=xlTopToBottom

' Step 8 - Filter and copy (Default Data)
Sheets("Default Data").Select
' Filter on Column 17? (?) = ?
lFilterField1 = fMatchCol("x?x", Rows("1:1"))
lFilterField1 = 17   ' on the basis I have no idea what should be filtered
With Rows("1:1")
    If Not ActiveSheet.AutoFilterMode Then
        .AutoFilter
    End If
    .AutoFilter _
        Field:=lFilterField1, _
        Criteria1:=">07/12/2010", _
        Operator:=xlAnd, _
        Criteria2:="<07/19/2010"
End With
Cells.Copy

' Step 9 - Create new sheet (Span)
Sheets.Add.Name = "Span"
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:AZ").ColumnWidth = 20

' Step 10 - Filter and copy (Default Data)
Sheets("Default Data").Select
' Filter on Column 5? (?) = ?
' Filter on Column 7 (G) = Due By
lFilterField1 = fMatchCol("x?x", Rows("1:1"))
lFilterField1 = 5   ' on the basis I have no idea what should be filtered
lFilterField2 = fMatchCol("Due By", Rows("1:1"))
With Rows("1:1")
    If Not ActiveSheet.AutoFilterMode Then
        .AutoFilter
    End If
    .AutoFilter _
        Field:=lFilterField1, _
        Criteria1:="<>c", _
        Operator:=xlAnd
    .AutoFilter _
        Field:=lFilterField2, _
        Criteria1:=">07/19/2010", _
        Operator:=xlAnd, _
        Criteria2:="<07/26/2010"
End With
Cells.Copy

' Step 11 - Create new sheet (Lookahead)
Sheets.Add.Name = "Lookahead"
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:AZ").ColumnWidth = 20

' Step 12 - Select sheet(s)
Sheets("Default Data").Select
    Range("A1").Select
    If Not ActiveSheet.AutoFilterMode Then
        Range("A1").AutoFilter
    End If
Sheets("Span").Select
    Range("A1").Select
    If Not ActiveSheet.AutoFilterMode Then
        Range("A1").AutoFilter
    End If
Sheets("Overdue").Select
    Range("A1").Select
    If Not ActiveSheet.AutoFilterMode Then
        Range("A1").AutoFilter
    End If
Sheets("Percent OT").Select
    Range("A1").Select
    If Not ActiveSheet.AutoFilterMode Then
        Range("A1").AutoFilter
    End If

Application.ScreenUpdating = True
Debug.Print "Test End " & Now()
End Sub

Function fMatchCol(sSearch As String, rSearchRange As Range) As Long
' UDF to find filter column based on column header
Dim AWF As WorksheetFunction
Set AWF = Application.WorksheetFunction
Dim lMatchCol As Long
lMatchCol = 0
On Error Resume Next
lMatchCol = AWF.Match(sSearch, rSearchRange, 0)
On Error GoTo 0
fMatchCol = lMatchCol
End Function

Enjoy!

@RoyUK Sorry, which bit of code wasn't tagged ?