Repeating a Loop With Changes

[Origamifan92]

I have some code that I'm trying to simplify, shown below. The overall macro is used to clear several sheets but one, sort all rows in the filled sheet, then copy and paste from one sheet to another according to values in a column. It works quickly and well, sorting about 70 lines in under 15 seconds, but is rather redundant. I've included an example showing how it's redundant. The code is basic enough to check for a value, then copy the line and paste in another sheet, but I'm wondering if there's a way to change it that, rather than have several lines and several IF statements, it's possible to condense the whole thing that it will alternate the desired checked value and sheets.

'Begin one sort loop

        If check_value = "Administrative" Then

            ActiveCell.EntireRow.Copy

            Sheets("Admin").Select

            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

            Range("A" & Rows.Count).End(xlUp).Offset(1).Select

            ActiveSheet.Paste

            Application.ScreenUpdating = False

            Columns(6).EntireColumn.Delete

            Application.ScreenUpdating = False

            Sheets("Master").Select

            Application.ScreenUpdating = False

        End If

'End one sort loop

        If check_value = "Care Mgmnt" Then

            ActiveCell.EntireRow.Copy

            Sheets("Care Mgmnt").Select

            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

            Range("A" & Rows.Count).End(xlUp).Offset(1).Select

            ActiveSheet.Paste

            Application.ScreenUpdating = False

            Columns(6).EntireColumn.Delete

            Application.ScreenUpdating = False

            Sheets("Master").Select

            Application.ScreenUpdating = False

        End If

 

[Yongle]

1 It is not neceassry to select the other sheet to paste values there - refer to the sheet to paste and sort etc
2 If the sheet name is NOT the same as the value of check_value then VBA needs to be told what to change it to. Repeating the code should be unnecessary. It can be looped instead
3.if check_value is also used elsewhere then use another variable to capture the sheet name

        If check_value = "Administrative" Then check_value = "Admin"
        If check_value = "Accounting"  Then check_value = "Accs"
        nothing required for Care Mgmnt because check_value is correct already
                
        ActiveCell.EntireRow.Copy Destination: Sheets(check_value).Cells(Cells.Rows.Count, "A").End(xlUp).Offset (2)
        Sheets(check_value).Columns(6).EntireColumn.Delete

Using another variable

        Dim sheet_name As String

        sheet_name= check_value
        If check_value = "Administrative" Then sheet_name = "Admin"
        If check_value = "Accounting"  Then sheet_name = "Accs"
        nothing required for Care Mgmnt because check_value is correct already
                
        ActiveCell.EntireRow.Copy Destination: Sheets(sheet_name).Cells(Cells.Rows.Count, "A").End(xlUp).Offset (2)
        Sheets(sheet_name).Columns(6).EntireColumn.Delete

 

[Origamifan92]

That has already removed a lot of unnecessary code, so thank you, however I'm getting a run error 1004 after Destination: sheets. If I change it to Destination:=sheets, then I get run error 9

 

[Yongle]

Ah - oops - a vital character is indeed missing

this is correct

Destination:[COLOR=#ff0000]=[/COLOR]

Try setting the sheet first

Dim ws As Worksheet
Set ws = Sheets(check_value) 
[COLOR=#ff0000]OR[/COLOR] if you are using variable [I]sheet_name [/I]
Set ws = Sheets(sheet_name)

[B]AND[/B] amend this line to match
ActiveCell.EntireRow.Copy Destination:= [COLOR=#ff0000]ws[/COLOR].Cells(Rows.Count, "A").End(xlUp).Offset (2)

Iif VBA fails when setting the sheet then the sheet name does not exist (ie the value of the variable is not matching up)

 

[Origamifan92]

Thank you! I'll edit that after lunch and let you know how it goes
Since it's in the same macro, may as well ask: is there an easy way of combining sorting in multiple fields? Like right now I have it somewhat like this (pardon the lack of code, doing this from my phone):
(Sort on column A, a-z)
(Sort on column B, old-new)
(Sort on column D, a-z)

Even if there is no easy way to sort them, with the code you've given me and getting rid of me being overzealous with not updating the screen, I'll be around 1/4 the previous number of lines, so you've really helped!

 

[Origamifan92]

I tried what you suggested, and it gave error 9 again on the following line:
Set ws=Sheets (check_value)

 

[Yongle]

Like i said, the value of check_value is not matching a worksheet name
- so it is either incorrect or empty

Put this line immediately above Set ws=Sheets (check_value) and look at the result in the VBA Immediate Window.

Debug.Print check_value

In VBA use {CTRL} G to view the immediate window
The last entry is the offending string
If nothing is listed then check_value is empty

 

[Origamifan92]

That was the error. Backing up to see if it's something earlier.
I want it to pull the values from column f with a header and sort accordingly. Here's what I have:

'stuff pulling from E as needed
End If
Range ("f" & i). Select
check_value=ActiveCell
If check_value="Administrative" Then check_value="Admin"
(Define some more check_values in subsequent lines)
Dim ws As Worksheet:
Set ws = Sheets (check_value)

 

[Yongle]

I will not start guessing

Record a macro as you sort manually
- it will get you a long way
-amend the code to use variables instead of fixed ranges etc

Post the code when you cannot get any futher
- make sure that your code is WORKING when you post it

 

[Origamifan92]

Here's the previous version I backed up while tweaking the code. It ran, but was incredibly lengthy compared to what it did:

Sub Copy_to_Individuals()

    Application.Calculation = xlCalculationManual

    Application.ScreenUpdating = False

    Application.DisplayStatusBar = False

'Start clearing sheets

    'Put one "Word" per tab to clear

    Sheets(Array("Active", "Admin", "Care Mgmnt", "Contracts", "County", "CSP", "Fiscal", "MOW", "PT EEs", "Protective", "Sr. Centers", "Technical", "Transport.")).Select

    Rows("2:" & Rows.Count).ClearContents

'Sort Master sheet

    Sheets("Master").Select

    With ActiveSheet.Sort

        .SortFields.Add Key:=Range("A1"), Order:=xlAscending

        .SortFields.Add Key:=Range("B1"), Order:=xlAscending

        .SortFields.Add Key:=Range("C1"), Order:=xlAscending

        .SetRange Range("A1:F1000")

        .Header = xlYes

        .Apply

    End With

    RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row

'Sort active policies

    For i = 1 To RowCount

        Range("e" & i).Select

        check_value = ActiveCell

        If check_value = "Active" Then

            ActiveCell.EntireRow.Copy

            Sheets("Active").Select

            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

            Range("A" & Rows.Count).End(xlUp).Offset(1).Select

            ActiveSheet.Paste

            Columns(5).EntireColumn.Delete

            Columns(6).EntireColumn.Delete

            Sheets("Master").Select

        End If

'Begin sorting process

        Range("f" & i).Select

        check_value = ActiveCell

'Begin one sort loop

        If check_value = "Administrative" Then

            ActiveCell.EntireRow.Copy

            Sheets("Admin").Select

            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

            Range("A" & Rows.Count).End(xlUp).Offset(1).Select

            ActiveSheet.Paste

            Columns(6).EntireColumn.Delete

            Sheets("Master").Select

        End If

'End one sort loop

        If check_value = "Care Mgmnt" Then

            ActiveCell.EntireRow.Copy

            Sheets("Care Mgmnt").Select

            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

            Range("A" & Rows.Count).End(xlUp).Offset(1).Select

            ActiveSheet.Paste

            Columns(6).EntireColumn.Delete

            Sheets("Master").Select

        End If

        If check_value = "Contracts" Then

            ActiveCell.EntireRow.Copy

            Sheets("Contracts").Select

            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

            Range("A" & Rows.Count).End(xlUp).Offset(1).Select

            ActiveSheet.Paste

            Columns(6).EntireColumn.Delete

            Sheets("Master").Select

        End If

        If check_value = "County" Then

            ActiveCell.EntireRow.Copy

            Sheets("County").Select

            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

            Range("A" & Rows.Count).End(xlUp).Offset(1).Select

            ActiveSheet.Paste

            Columns(6).EntireColumn.Delete

            Sheets("Master").Select

        End If

        If check_value = "CSP" Then

            ActiveCell.EntireRow.Copy

            Sheets("CSP").Select

            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

            Range("A" & Rows.Count).End(xlUp).Offset(1).Select

            ActiveSheet.Paste

            Columns(6).EntireColumn.Delete

            Sheets("Master").Select

        End If

        If check_value = "Fiscal" Then

            ActiveCell.EntireRow.Copy

            Sheets("Fiscal").Select

            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

            Range("A" & Rows.Count).End(xlUp).Offset(1).Select

            ActiveSheet.Paste

            Columns(6).EntireColumn.Delete

            Sheets("Master").Select

        End If

        If check_value = "MOW" Then

            ActiveCell.EntireRow.Copy

            Sheets("MOW").Select

            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

            Range("A" & Rows.Count).End(xlUp).Offset(1).Select

            ActiveSheet.Paste

            Columns(6).EntireColumn.Delete

            Sheets("Master").Select

        End If

        If check_value = "Part Time EEs" Then

            ActiveCell.EntireRow.Copy

            Sheets("PT EEs").Select

            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

            Range("A" & Rows.Count).End(xlUp).Offset(1).Select

            ActiveSheet.Paste

            Columns(6).EntireColumn.Delete

            Sheets("Master").Select

        End If

        If check_value = "Protective" Then

            ActiveCell.EntireRow.Copy

            Sheets("Protective").Select

            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

            Range("A" & Rows.Count).End(xlUp).Offset(1).Select

            ActiveSheet.Paste

            Columns(6).EntireColumn.Delete

            Sheets("Master").Select

        End If

        If check_value = "Senior Centers" Then

            ActiveCell.EntireRow.Copy

            Sheets("Sr. Centers").Select

            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

            Range("A" & Rows.Count).End(xlUp).Offset(1).Select

            ActiveSheet.Paste

            Columns(6).EntireColumn.Delete

            Sheets("Master").Select

        End If

        If check_value = "Technical" Then

            ActiveCell.EntireRow.Copy

            Sheets("Technical").Select

            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

            Range("A" & Rows.Count).End(xlUp).Offset(1).Select

            ActiveSheet.Paste

            Columns(6).EntireColumn.Delete

            Sheets("Master").Select

        End If

        If check_value = "Transportation" Then

            ActiveCell.EntireRow.Copy

            Sheets("Transport.").Select

            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

            Range("A" & Rows.Count).End(xlUp).Offset(1).Select

            ActiveSheet.Paste

            Columns(6).EntireColumn.Delete

            Sheets("Master").Select

        End If

    'All policies sorted

'Update screen to reflect updates

    Next

    Application.Calculation = xlCalculationAutomatic

    Application.ScreenUpdating = True

    Application.DisplayStatusBar = True

End Sub