help me clean up this code

D

Dave F

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
 
B

Bernie Deitrick

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).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


Dave F said:
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
Click to expand...
 
D

Dave F

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 are: (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

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).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




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.
Click to expand...
Following is the code:
Click to expand...
Option Explicit
Click to expand...
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
Click to expand...
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
Click to expand...
'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
Click to expand...
myFileName = Application.GetSaveAsFilename
If myFileName = False Then
Exit Sub
End If
ActiveWorkbook.SaveAs Filename:=myFileName,
FileFormat:=xlWorkbookNormal
End Sub

Dave- Hide quoted text -
Click to expand...

- Show quoted text -
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

why does this macro delete the value in A1? 1
formula in VBA 2
Help again!!! 1
macro recorder and formulas 2
Clean this select case code up a bit. 2
wrong code 1
variable number of rows. 3
Cleanup this macro please 3

Top