I have the following macro that needs to be cleaned up a bit (part of
the code was generated using the macro recorder; this is the stuff
that I think needs to be cleaned up.

Following is the code:

Option Explicit

Sub ParseELR()
'Parses the ELR report, filters it, copies the filtered records,
pastes them into a new workbook
'and prompts the user to save the file to a specific location
Dim myFileName As Variant

Range("A3").Select
If ActiveSheet.AutoFilterMode = True Then
ActiveSheet.ShowAllData
End If
Range("T2").Select
ActiveCell.FormulaR1C1 = "=IF(AND(ISNUMBER(MATCH(LEFT(RC[-18],
3),'[ELR expense account identification.xls]Sheet1'!
R2C1:R12C1,0)),ISNUMBER(MATCH(RC[-17],'[Frank''s expense codes--GDCS
and non-GDCS.xls]Sheet1'!R2C1:R39C1,0))),""Extract"","""")"
'Applies the filter criteria to each row; if BOTH conditions
return TRUE, "Extract" is returned in Column T

'THIS IS THE SECTION THAT NEEDS TO BE CLEANED UP
Range("T2:T65000").Select
Selection.FillDown
Selection.End(xlUp).Select
Selection.AutoFilter Field:=20, Criteria1:="Extract"
'Runs autofilter on the value "extract" in Column T
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
'END SECTION THAT NEEDS TO BE CLEANED UP

myFileName = Application.GetSaveAsFilename
If myFileName = False Then
Exit Sub
End If
ActiveWorkbook.SaveAs Filename:=myFileName,
FileFormat:=xlWorkbookNormal
End Sub

Thanks,

Dave

Dave,

Not sure what your code does, since you did not describe the worksheet layout. But, try the macro
below.

HTH,
Bernie
MS Excel MVP

Sub ParseELR()
'Parses the ELR report, filters it, copies the filtered records,
'pastes them into a new workbook
'and prompts the user to save the file to a specific location
Dim myFileName As String
Dim myRow As Long
If ActiveSheet.AutoFilterMode = True Then
ActiveSheet.ShowAllData
End If

myRow = Cells(Rows.Count, 2).End(xlUp).Row

'Applies the filter criteria to each row;
'if BOTH conditions return TRUE,
'"Extract" is returned in Column T
Range("T2:T" & myRow).FormulaR1C1 = "=IF(AND(ISNUMBER(MATCH(LEFT(RC[-18],3)," _
& "'[ELR expense account identification.xls]Sheet1'!R2C1:R12C1,0))," & _
"ISNUMBER(MATCH(RC[-17],'[Frank''s expense codes--GDCS and non-GDCS.xls]" & _
"Sheet1'!R2C1:R39C1,0))),""Extract"","""")"

Range("T1:T" & myRow).AutoFilter Field:=1, Criteria1:="Extract"

'Runs autofilter on the value "extract" in Column T
Range("T2:T" & myRow).EntireRow.SpecialCells(xlCellTypeVisible).C opy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
'END SECTION THAT NEEDS TO BE CLEANED UP

myFileName = Application.GetSaveAsFilename
If myFileName = False Then
Exit Sub
End If
ActiveWorkbook.SaveAs Filename:=myFileName, FileFormat:=xlWorkbookNormal
End Sub


"Dave F" wrote in message
oups.com...
I have the following macro that needs to be cleaned up a bit (part of
the code was generated using the macro recorder; this is the stuff
that I think needs to be cleaned up.

Following is the code:

Option Explicit

Sub ParseELR()
'Parses the ELR report, filters it, copies the filtered records,
pastes them into a new workbook
'and prompts the user to save the file to a specific location
Dim myFileName As Variant

Range("A3").Select
If ActiveSheet.AutoFilterMode = True Then
ActiveSheet.ShowAllData
End If
Range("T2").Select
ActiveCell.FormulaR1C1 = "=IF(AND(ISNUMBER(MATCH(LEFT(RC[-18],
3),'[ELR expense account identification.xls]Sheet1'!
R2C1:R12C1,0)),ISNUMBER(MATCH(RC[-17],'[Frank''s expense codes--GDCS
and non-GDCS.xls]Sheet1'!R2C1:R39C1,0))),""Extract"","""")"
'Applies the filter criteria to each row; if BOTH conditions
return TRUE, "Extract" is returned in Column T

'THIS IS THE SECTION THAT NEEDS TO BE CLEANED UP
Range("T2:T65000").Select
Selection.FillDown
Selection.End(xlUp).Select
Selection.AutoFilter Field:=20, Criteria1:="Extract"
'Runs autofilter on the value "extract" in Column T
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
'END SECTION THAT NEEDS TO BE CLEANED UP

myFileName = Application.GetSaveAsFilename
If myFileName = False Then
Exit Sub
End If
ActiveWorkbook.SaveAs Filename:=myFileName,
FileFormat:=xlWorkbookNormal
End Sub

Thanks,

Dave

Sorry. The worksheet layout is a table, range A1:S65000. The formula
in the macro is entered in T2 and filled down to T65000. The formula
performs a test on data in column B and a second test on column C of
the aforementioned range, and where both tests resolve to TRUE, the
value "extract" is returned in column T for each row.

These two tests a (1) do the three left characters in B2 match any
value in the range B2:B12 in an external worksheet, and (2) does the
value in C2 match any value in the range B2:B39 in a second external
worksheet.

Then the macro is supposed to filter this huge table on the "extract"
value in column T, copy the filtered data, paste in a new worksheet,
and prompt the user for a file name/save location.

The same thing could be done with SQL by relating the three tables of
data to one another, but the point of this exercise is that I can just
put a button on this report and a non-tech user would just need to
click the button and have the data filtered and extracted.

Your code is helpful, though, thanks. It appears to do exactly what I
want.

Dave

On Jun 14, 1:12 pm, "Bernie Deitrick" <deitbe @ consumer dot org
wrote:
Dave,

Not sure what your code does, since you did not describe the worksheet layout. But, try the macro
below.

HTH,
Bernie
MS Excel MVP

Sub ParseELR()
'Parses the ELR report, filters it, copies the filtered records,
'pastes them into a new workbook
'and prompts the user to save the file to a specific location
Dim myFileName As String
Dim myRow As Long
If ActiveSheet.AutoFilterMode = True Then
ActiveSheet.ShowAllData
End If

myRow = Cells(Rows.Count, 2).End(xlUp).Row

'Applies the filter criteria to each row;
'if BOTH conditions return TRUE,
'"Extract" is returned in Column T
Range("T2:T" & myRow).FormulaR1C1 = "=IF(AND(ISNUMBER(MATCH(LEFT(RC[-18],3)," _
& "'[ELR expense account identification.xls]Sheet1'!R2C1:R12C1,0))," & _
"ISNUMBER(MATCH(RC[-17],'[Frank''s expense codes--GDCS and non-GDCS.xls]" & _
"Sheet1'!R2C1:R39C1,0))),""Extract"","""")"

Range("T1:T" & myRow).AutoFilter Field:=1, Criteria1:="Extract"

'Runs autofilter on the value "extract" in Column T
Range("T2:T" & myRow).EntireRow.SpecialCells(xlCellTypeVisible).C opy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
'END SECTION THAT NEEDS TO BE CLEANED UP

myFileName = Application.GetSaveAsFilename
If myFileName = False Then
Exit Sub
End If
ActiveWorkbook.SaveAs Filename:=myFileName, FileFormat:=xlWorkbookNormal
End Sub

"Dave F" wrote in message

oups.com...



I have the following macro that needs to be cleaned up a bit (part of
the code was generated using the macro recorder; this is the stuff
that I think needs to be cleaned up.

Following is the code:

Option Explicit

Sub ParseELR()
'Parses the ELR report, filters it, copies the filtered records,
pastes them into a new workbook
'and prompts the user to save the file to a specific location
Dim myFileName As Variant

Range("A3").Select
If ActiveSheet.AutoFilterMode = True Then
ActiveSheet.ShowAllData
End If
Range("T2").Select
ActiveCell.FormulaR1C1 = "=IF(AND(ISNUMBER(MATCH(LEFT(RC[-18],
3),'[ELR expense account identification.xls]Sheet1'!
R2C1:R12C1,0)),ISNUMBER(MATCH(RC[-17],'[Frank''s expense codes--GDCS
and non-GDCS.xls]Sheet1'!R2C1:R39C1,0))),""Extract"","""")"
'Applies the filter criteria to each row; if BOTH conditions
return TRUE, "Extract" is returned in Column T

'THIS IS THE SECTION THAT NEEDS TO BE CLEANED UP
Range("T2:T65000").Select
Selection.FillDown
Selection.End(xlUp).Select
Selection.AutoFilter Field:=20, Criteria1:="Extract"
'Runs autofilter on the value "extract" in Column T
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
'END SECTION THAT NEEDS TO BE CLEANED UP

myFileName = Application.GetSaveAsFilename
If myFileName = False Then
Exit Sub
End If
ActiveWorkbook.SaveAs Filename:=myFileName,
FileFormat:=xlWorkbookNormal
End Sub

Thanks,

Dave- Hide quoted text -

- Show quoted text -