Repeating a Loop With Changes

Origamifan92

New Member
Joined
Apr 9, 2019
Messages
7
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.
Code:
'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
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
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

Code:
        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

Code:
        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
 
Last edited:

Origamifan92

New Member
Joined
Apr 9, 2019
Messages
7
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

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
Ah - oops :oops::oops: - a vital character is indeed missing

this is correct
Code:
Destination:[COLOR=#ff0000]=[/COLOR]

Try setting the sheet first
Code:
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)
 
Last edited:

Origamifan92

New Member
Joined
Apr 9, 2019
Messages
7

ADVERTISEMENT

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

New Member
Joined
Apr 9, 2019
Messages
7
I tried what you suggested, and it gave error 9 again on the following line:
Set ws=Sheets (check_value)
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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.
Code:
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

New Member
Joined
Apr 9, 2019
Messages
7
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

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Apr 9, 2019
Messages
7
Here's the previous version I backed up while tweaking the code. It ran, but was incredibly lengthy compared to what it did:
Code:
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
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,122,959
Messages
5,599,056
Members
414,281
Latest member
Engjamal2021

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top