Beat Way To Copy Using VBA

[MikeG]

I have a worksheet called Regions that has 6 worksheets - one for each geographical sales region. Each Region worksheet has a list of projects. Each project can either be "open" or "closed". The number of projects in each list changes, as projects are added, deleted, or midified. The number of projects in each region varies, but averages 200 of which about half are "open."

In a sperate summary workbook, I want to keep a consolidated list of all open projects. This consolidated list will be updated weekly and I want a macro that will grab the list of open projects from each Region worksheet and put them into the one consolidated list in this Summary workbook.

My question is, what is the best way to do this. I have thought of two options.

1) Go to the first Region worksheet and copy the list in that worksheet, including all Open and Closed projects. Paste this to the consolidated list. Go to the next Region sheet, copy the list there, return to the consolidated list and append this new data to what's already been copied. Then go to the next Region worksheet, and so on. Once all data has been copied, sort by Open and Closed and delete the Closed.

2) Go to each Region worksheet, do a loop in the macro that runs through each row and let the value of the next empty cell in the consolidated list equal the value of the current cell in the Region worksheet. Use an IF statement in the loop to exclude all Completed project rows.

Speed is not a big consideration here since it is only done once per week. I am more interested in the simplest macro that others could more easily understand (and me!).

The consololidated list will start fresh each week - there is no need to "update" it, but rather it will be overwritten by the new Regions data.



Based on your expertize and experience, which option is best, or are there others?

Thanks,

MikeG

 

[Norie]

How about looping through all the worksheets, extracting all the Open projects and transferrring them to the summary sheet?

That could be done if the list of projects is simply 2 columns, one with name and one with status (Closed/Open).

Something like this which assumes the list is in columns A (Name) and B (Status).

Option Explicit
Sub GetOpenProjects()
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim wsCrit As Worksheet
Dim rngCrit As Range
Dim rngSrc As Range
Dim rngDst As Range
Dim LastRowSrc As Long
    Set wsDst = Worksheets("Summary")
    Set rngDst = wsDst.Range("A1")
    Set wsCrit = Worksheets.Add
    Set rngCrit = wsCrit.Range("A1:A2")
    rngCrit.Cells(1) = "Status"
    rngCrit.Cells(2) = "Open"
    For Each wsSrc In ThisWorkbook.Worksheets
        Select Case wsSrc.Name
            Case wsDst.Name, wsCrit.Name
                ' do nothing
            Case Else
                LastRowSrc = wsSrc.Range("A" & Rows.Count).End(xlUp).Row
                Set rngSrc = wsSrc.Range("A1:B" & LastRowSrc)
                rngSrc.AdvancedFilter xlFilterCopy, rngCrit, rngDst
                rngDst.Resize(, 2).Delete xlShiftUp
                Set rngDst = wsDst.Range("A" & Rows.Count).End(xlUp).Offset(1)
        End Select
    Next wsSrc

    Application.DisplayAlerts = False
    wsCrit.Delete
    Application.DisplayAlerts = True
End Sub

 

[MikeG]

How about looping through all the worksheets, extracting all the Open projects and transferrring them to the summary sheet?

That could be done if the list of projects is simply 2 columns, one with name and one with status (Closed/Open).

Something like this which assumes the list is in columns A (Name) and B (Status).

Option Explicit
Sub GetOpenProjects()
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim wsCrit As Worksheet
Dim rngCrit As Range
Dim rngSrc As Range
Dim rngDst As Range
Dim LastRowSrc As Long
    Set wsDst = Worksheets("Summary")
    Set rngDst = wsDst.Range("A1")
    Set wsCrit = Worksheets.Add
    Set rngCrit = wsCrit.Range("A1:A2")
    rngCrit.Cells(1) = "Status"
    rngCrit.Cells(2) = "Open"
    For Each wsSrc In ThisWorkbook.Worksheets
        Select Case wsSrc.Name
            Case wsDst.Name, wsCrit.Name
                ' do nothing
            Case Else
                LastRowSrc = wsSrc.Range("A" & Rows.Count).End(xlUp).Row
                Set rngSrc = wsSrc.Range("A1:B" & LastRowSrc)
                rngSrc.AdvancedFilter xlFilterCopy, rngCrit, rngDst
                rngDst.Resize(, 2).Delete xlShiftUp
                Set rngDst = wsDst.Range("A" & Rows.Count).End(xlUp).Offset(1)
        End Select
    Next wsSrc

    Application.DisplayAlerts = False
    wsCrit.Delete
    Application.DisplayAlerts = True
End Sub

Thanks Norie - that's really great.

Thanks,

Mike

 

[MikeG]

Norie:

The code works perfectly and is fast. Could you help with one more thing - I want the summary worksheet to be in a seperate workbook also called "Summary". I will put the code in the Summary workbook. The Region worksheets are in a workbook called "Regions". Could you tell me how to modify the code to deal with this?

Thanks again,

Mike