collecting rows into summary sheet

fearfour

New Member
Joined
Sep 19, 2006
Messages
14
Hi everyone, I need to copy all rows with the phrase "bid price too high" and "bid price too low" and paste them into a summary sheet. I have several sheets with this data in them. Some of these sheets are longer or shorter (i.e. more or fewer rows but the columns are all the same). More specifically, the data that I need to summarize appears in sheets 5 through 12 of my workbook, and I would like to copy the rows into a page called "Summary". Any ideas? Thank you so much for your help!
example.xls
PQRS
4Pricedifference(MostRecentPriceminusBidPrice)Price-differences[%](CurrentvsBidPrice)RedFlag(Pricebidtoohigh/low)
5-$1.2019.87%
6$0.12-9.23%
7-$0.1324.51%
8$0.27-23.08%
9-$0.022.08%
10$0.08-6.82%
11$0.07-6.48%
12-$0.043.74%
13-$0.128.89%
14-$0.076.09%
15-$0.053.73%
16$0.41-45.56%BidPriceTooLow!
17$0.03-2.34%
18$0.12-8.76%
19$0.07-3.66%
20-$0.2224.72%
21$0.16-9.47%
22-$0.1621.83%
23$0.10-9.80%
24-$0.5945.38%BidPriceTooHigh!
25$0.14-28.00%
26-$0.025.26%
Sheet1
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Smitty

Legend
Joined
May 15, 2003
Messages
29,536
How's this for a start:

<font face=Tahoma><SPAN style="color:#00007F">Sub</SPAN> foo()
    <SPAN style="color:#00007F">Dim</SPAN> c <SPAN style="color:#00007F">As</SPAN> Range, LastRow <SPAN style="color:#00007F">As</SPAN> Range
    <SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>
        Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
            <SPAN style="color:#00007F">For</SPAN> i = 5 <SPAN style="color:#00007F">To</SPAN> 12
                <SPAN style="color:#00007F">With</SPAN> Sheets(i)
                    .Activate
                    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> Range([C2], Cells(Rows.Count, "C").End(xlUp))
                        <SPAN style="color:#00007F">If</SPAN> Left(c, 3) = "Bid" <SPAN style="color:#00007F">Then</SPAN>
                            <SPAN style="color:#00007F">Set</SPAN> LastRow = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp)
                                <SPAN style="color:#00007F">With</SPAN> LastRow
                                    .Offset(1) = c.Offset(, -2)
                                    .Offset(1, 1) = c.Offset(, -1)
                                    .Offset(1, 2) = c
                                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
                            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
                        <SPAN style="color:#00007F">Next</SPAN> c
                    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
                <SPAN style="color:#00007F">Next</SPAN> i
                Sheets("Summary").Activate
            Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

HTH,

Smitty

(I'm outta' here for the day! :))
 

fearfour

New Member
Joined
Sep 19, 2006
Messages
14
Hey there Pennysaver, should I change the ranges labeled "C" to R since the column containing the flag is R?
 

pfarmer

Well-known Member
Joined
Jul 6, 2005
Messages
550

ADVERTISEMENT

Hi everyone, I need to copy all rows with the phrase "bid price too high" and "bid price too low" and paste them into a summary sheet. I have several sheets with this data in them. Some of these sheets are longer or shorter (i.e. more or fewer rows but the columns are all the same). More specifically, the data that I need to summarize appears in sheets 5 through 12 of my workbook, and I would like to copy the rows into a page called "Summary". Any ideas? Thank you so much for your help!

I'll post the following as is. Basically in this example it cycles through all sheets (there are 250+ of them) and transfers all rows starting on row three from each sheet to a summary sheet called 'Master'. With the data in each sheet, the sheet name precedes it (the sheet names are the companies involved, the data their employees).

In your case you would be doing basically the same but you would check to see if values are too high or too low.

Basically this is code picked up elsewhere that I modified for my use. I was surprised at its speed, for 4500 entries on a relatively slow machine it took under two seconds.

If you take a close look I think you will see that it is actually very similar in concept to pennysavers (which means you may want to use his instead and modify it for your needs). To the concept is added a few items such as autofit, etc. of columns, the creation of the 'Master' sheet, column headers, but it is basically the same concept.

Code:
Sub CopyFromWorksheets()
    Dim wrk As Workbook 'Workbook object - Always good to work with object variables
    Dim sht As Worksheet 'Object for handling worksheets in loop
    Dim trg As Worksheet 'Master Worksheet
    Dim rng As Range 'Range object
    Dim colCount As Integer 'Column count in tables in the worksheets
    Dim n
    n = 1
    
    Set wrk = ActiveWorkbook 'Working in active workbook
      
'    For Each sht In wrk.Worksheets
'        If sht.Name = "Master" Then
'            MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
'            "Please remove or rename this worksheet since 'Master' would be" & _
'            "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
'            Exit Sub
'        End If
'    Next sht
      
     'We don't want screen updating
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
On Error Resume Next
    Sheets("Master").Delete

    Application.DisplayAlerts = True
     'Add new worksheet as the last worksheet
    Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
     'Rename the new worksheet
    trg.Name = "Master"
     'Get column headers from the first worksheet
     'Column count first
    Set sht = wrk.Worksheets(1)
    colCount = sht.Cells(1, 255).End(xlToLeft).Column + 3
     'Now retrieve headers, no copy&paste needed
    With trg.Cells(1, 2).Resize(1, colCount)
        .Value = sht.Cells(1, 1).Resize(1, colCount).Value
        .Font.Bold = True
    End With
    trg.Cells(1, 1) = "Contractor"
    trg.Cells(1, 1).Font.Bold = True
    trg.Cells(1, 7) = "Contractor List"
    trg.Cells(1, 7).Font.Bold = True
        
     'We can start loop
    For Each sht In wrk.Worksheets
         'If worksheet in loop is the last one, stop execution (it is Master worksheet)
        If sht.Index = wrk.Worksheets.Count Then
            Exit For
        End If
        n = n + 1
         'Data range in worksheet - starts from third row as first rows are the header rows in all worksheets
        Set rng = sht.Range(sht.Cells(3, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))

         'Put data into the Master worksheet
        trg.Cells(65536, 2).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
        trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, 1).Value = sht.Name
    trg.Cells(n, 7).Value = sht.Name
    Next sht
     'Fit the columns in Master worksheet
    trg.Columns.AutoFit

    Range("G2").Select
    ActiveWindow.FreezePanes = True

     'Screen updating should be activated
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
End Sub

Perry
 

Smitty

Legend
Joined
May 15, 2003
Messages
29,536
should I change the ranges labeled "C" to R since the column containing the flag is R?

Yes.

Also, can we make it so that it copies the WHOLE row?

Yes, by replacing the With LastRow part with:

Code:
c.EntireRow.Copy LastRow(Offset(1)

Smitty
 

fearfour

New Member
Joined
Sep 19, 2006
Messages
14
Hi Pennysaver, this code does not seem to work for me, even when I try using it just as-is. It produces an error at the line

With Sheets(i)
.Activate


Also in terms of copying the whole row, do you mean that I should replace the entire three lines

.Offset(1) = c.Offset(, -2)
.Offset(1, 1) = c.Offset(, -1)
.Offset(1, 2) = c

With just the line:

c.EntireRow.Copy LastRow(Offset(1)

Also, it looks to me like that is missing a parenthesis.....

At any rate I would love to use this macro but it is just not working...

Thanks for your help though!
 

Smitty

Legend
Joined
May 15, 2003
Messages
29,536
It produces an error at the line

With Sheets(i)
.Activate

I don't know why it would be failing there unless the sheets are hidden.

Also in terms of copying the whole row, do you mean that I should replace the entire three lines

Yes, replace the entire With statement.

c.EntireRow.Copy LastRow(Offset(1)

Also, it looks to me like that is missing a parenthesis.....

Sorry, typo on my part, it should be:

Code:
c.EntireRow.Copy LastRow.Offset(1)

Code:
Sub foo()
    Dim c As Range, LastRow As Range
    Dim i As Integer
        Application.ScreenUpdating = False
            For i = 5 To 12
                With Sheets(i)
                    .Activate
                    For Each c In Range([R2], Cells(Rows.Count, "R").End(xlUp))
                        If Left(c, 3) = "Bid" Then
                            Set LastRow = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp)
                             c.EntireRow.Copy LastRow.Offset(1)
                         End If
                      Next c
                    End With
                Next i
                Sheets("Summary").Activate
            Application.ScreenUpdating = True
End Sub

The code could be simplified, but I wrote it on the way out the door last night. Let's get it working first though...

Smitty
 

Forum statistics

Threads
1,141,625
Messages
5,707,476
Members
421,510
Latest member
haroonstr

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