Streamline Bulky Code to Filter Data & Copy to Sheets

[Cowzilla]

Hi There,

I have a very bulky code that I'd like to streamline so it works faster.

What it does: Change format of one column to remove leading/ending characters (TRIM), filter data (based on initials) and copy that data to existing labeled worksheets (i.e. the intials are "AM", the filter will copy rows 2 through 4 on the "Raw" sheet (basically the header) and the data for "AM" and paste it to the worksheet labeled "AM". Then it autofits any columns that may be too narrow for the copied data.

What I'd like it to do: Keep the TRIM; filter data based on one, or up to 4, criteria. Copy rows 2 through 4 from the "Raw" sheet and the filtered data to the appropriate labeled worksheet. Apply the autofits to any columns that are too narrow.

Below I've pasted the existing code. I'm not very good at writing code, and I know there are ways to improve what I have, so any help would be most appreciated!

Sub Split()
'
' Macro1 Macro
'
' Sheets("Raw").Select
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Selection.NumberFormat = "General"
Range("D6").Select
ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])"
Range("D6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FillDown
Selection.Copy
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("D:D").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Sheet("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="BG"
Rows("2:5000").Select
Selection.Copy
Sheets("BG").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="BM"
Rows("2:5000").Select
Selection.Copy
Sheets("BM").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="BN", Operator:=xlOr, Criteria2:="JA"
Rows("2:5000").Select
Selection.Copy
Sheets("BN & JA").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="DY"
Rows("2:5000").Select
Selection.Copy
Sheets("DY").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="EC", Operator:=xlOr, Criteria2:="GT"
Rows("2:5000").Select
Selection.Copy
Sheets("EC & GT").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="FB"
Rows("2:5000").Select
Selection.Copy
Sheets("FB").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="GP"
Rows("2:5000").Select
Selection.Copy
Sheets("GP").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="GW"
Rows("2:5000").Select
Selection.Copy
Sheets("GW").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="JAP"
Rows("2:5000").Select
Selection.Copy
Sheets("JAP").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="JH"
Rows("2:5000").Select
Selection.Copy
Sheets("JH").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="JM"
Rows("2:5000").Select
Selection.Copy
Sheets("JM").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="JP"
Rows("2:5000").Select
Selection.Copy
Sheets("JP").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="JR"
Rows("2:5000").Select
Selection.Copy
Sheets("JR").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="MAB"
Rows("2:5000").Select
Selection.Copy
Sheets("MAB").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="MB"
Rows("2:5000").Select
Selection.Copy
Sheets("MB").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="MIH"
Rows("2:5000").Select
Selection.Copy
Sheets("MIH").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="MJ"
Rows("2:5000").Select
Selection.Copy
Sheets("MJ").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="TC", Operator:=xlOr, Criteria2:="TJ"
Rows("2:5000").Select
Selection.Copy
Sheets("TC & TJ").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter Field:=3, Criteria1:="AM", Operator:=xlOr, Criteria2:="WJ"
Rows("2:5000").Select
Selection.Copy
Sheets("WJ").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("B:M").Select
Columns("B:M").EntireColumn.AutoFit
Range("A1").Select
Sheets("Raw").Select
Rows("5:5").Select
Selection.AutoFilter
Range("A1").Select


End Sub

[stanleydgromjr]

Cowzilla,

I would think that your code is slow.....

The process could be a lot faster using arrays in memory.

Can you supply a copy of your workbook/worksheets?


To get the most precise answer, it is best to upload/attach a sample workbook (sensitive data scrubbed/removed/changed) that contains an example of your raw data on one worksheet, and on another worksheet your desired results.

The structure and data types of the sample workbook must exactly duplicate the real workbook. Include a clear and explicit explanation of your requirements.

To attach your workbook, scroll down and click on the Go Advanced button, then scroll down and click on the Manage Attachments button.

[Cowzilla]

I've attached a slimmed-down version of the workbook. The Raw tab contains the data to copy. The names on the individual tabs show which person's data (by initials) is included on that sheet.

As you can see, I have several macro buttons on the raw sheet to make this easier for my users. They are trained to Clear, Split, then apply Subtotals.

Ultimately, I need to update both the Split & Subtotal codes, but I figured I'd start with one and go from there.

Thank you for your help so far!

[stanleydgromjr]

Cowzilla,

Are we copying title rows 4 and 5 from worksheet Raw to the remaining worksheets?

We are working with column C Superintendent initials?

[stanleydgromjr]

Cowzilla,

Are we copying title rows 4 and 5 from worksheet Raw to the remaining worksheets? If so, then I will update the macro.

The following macro processed the 275 rows of data in worksheet Raw in 0.047 seconds.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Please Login or Register  to view this content.

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the DisributeRowsArray macro.

[stanleydgromjr]

Cowzilla,

the filter will copy rows 2 through 4 on the "Raw" sheet (basically the header) and the data for

I missed this part.

1. Is it rows 2 thru 4?

2. Or, is it rows 2 thru 5?

[stanleydgromjr]

Cowzilla,

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Please Login or Register  to view this content.

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the DisributeRowsArrayV2 macro.

[Cowzilla]

Hi stanley,

I get a Run Time error when the code gets to this point:

With Sheets("MJ")
nr = .Range("A" & Rows.Count).End(xlUp).Offset(1).Row
.Cells(nr, 1).Resize(UBound(s1, 1), UBound(s1, 2)) = s1

Also, it doesn't look like it's copying the actual data to the sheets, only the top rows from the Raw.

One more thing..how do I add sheets for new people?

Thank you so much for your help so far!

[stanleydgromjr]

Cowzilla,

The macro works correctly when run against your workbook that you supplied in reply #3.

If the macro is not working, then I will need to see the actual workbook that it is not working in (not a slimed down version).

One more thing..how do I add sheets for new people?

Explain in more detail.

[AB33]

Cowzilla,
I have deleted all the other sheets on the attached and assumed the raw data is the only sheet you have.

Please Login or Register  to view this content.