I've created an excel workbook with several worksheets.
In each worksheet, I've highlighted a number of the cells containing key
statistics in red.

Is there any easy one-step way that I can pull all of the cells
highlighted in red out of all of the worksheets in the workbook and list
them all in one separate worksheet? Or is there a macro you might
suggest?

Unfortunately, the red cells are not in any systematic order in the
worksheets (all the worksheets are rather different). Pulling the red
cells out would just have to be on the basis of color.

Àlso, if I have say 100 worksheets in a workbook each with a dataset, is
there a straightforward, one-step way that I could put all of the
datasets in the worksheets onto one worksheet?

Thank you.

Dave Shapiro







*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Maybe something like this that loops through each cell in the usedrange of each
worksheet:

Option Explicit
Sub testme01()

Dim wks As Worksheet
Dim SumWks As Worksheet
Dim myCell As Range
Dim oRow As Long

Set SumWks = Worksheets.Add
SumWks.Range("a1").Resize(1, 4).Value _
= Array("Sheet", "address", "value", "formula")

oRow = 1
For Each wks In ActiveWorkbook.Worksheets
If wks.Name = SumWks.Name Then
'do nothing
Else
With SumWks
For Each myCell In wks.UsedRange.Cells
If myCell.Interior.ColorIndex = 3 Then
oRow = oRow + 1
.Cells(oRow, "A").Value = "'" & wks.Name
.Cells(oRow, "B").Value = myCell.Address(0, 0)
.Cells(oRow, "C").Value = "'" & myCell.Value
.Cells(oRow, "D").Value = "'" & myCell.Formula
End If
Next myCell
End With
End If
Next wks
End Sub

(I'm not sure what your red's colorindex is, though.)

david shapiro wrote:

I've created an excel workbook with several worksheets.
In each worksheet, I've highlighted a number of the cells containing key
statistics in red.

Is there any easy one-step way that I can pull all of the cells
highlighted in red out of all of the worksheets in the workbook and list
them all in one separate worksheet? Or is there a macro you might
suggest?

Unfortunately, the red cells are not in any systematic order in the
worksheets (all the worksheets are rather different). Pulling the red
cells out would just have to be on the basis of color.

Àlso, if I have say 100 worksheets in a workbook each with a dataset, is
there a straightforward, one-step way that I could put all of the
datasets in the worksheets onto one worksheet?

Thank you.

Dave Shapiro

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

--

Dave Peterson

Dave,

Thanks for the VB code for extracting data from worksheets by color.

Rather than checking the entire worksheet cell by cell for colored
cells, I`m thinking it might be easier if the programme just checks the
second column of every row in the worksheet.

If it is red, then extract the entire row of cells of data and list all
the rows in the new worksheet. This would be done for all of the
worksheets in the workbook. So the new worksheet would contain all the
red rows from all the worksheets in the workbook.

All of rows in the worksheets have a standard number of columns (from
columns A to AB on the excel sheet). (If possible, it would be good if
the computer flagged when a worksheet did not have the standard A to AB
number of columns.)

How can I find out the right number for red in my color index?

I`ve also created the following code for preparing each of the
worksheets for the extraction process:

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("C1").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
Columns("A:C").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.FormulaR1C1 = "=R[-1]C"
End Sub

Would it be possible to alter the code so that it runs this procedure on
every worksheet in the workbook? And then add the extraction procedure
(which creates the new data sheet and extract the rows of data by color)
after this.

Overall, this is what the VB does:

1) It prepares the worksheets for the extraction process (this is done
for each worksheet in the workbook): the procedure for each worksheet
is above.

2) When all worksheets prepared, a new empty data sheet is created.

3) Search through each row of the worksheet for every row where the
second column is red. If column 2 of the row is red, extract the whole
row of cells and list in the new data sheet. Do procedure for all
worksheets.

4) New data sheet contains all rows in worksheets in workbook for which
the second column is red.

Hope the description isn`t too complicated. Thanks very much.

Dave

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

You could use your existing code and just select a sheet, run your code, select
a different sheet, run your code...

Sub doall()
dim wks as worksheet
for each wks in activeworkbook.worksheets
wks.select
call yourproc
next wks
end sub

or if you include it in the newer version:

Option Explicit
Sub testme01()

Dim wks As Worksheet
Dim SumWks As Worksheet
Dim myCell As Range
Dim oRow As Long

Set SumWks = Worksheets.Add

oRow = 0
For Each wks In ActiveWorkbook.Worksheets
If wks.Name = SumWks.Name Then
'do nothing
Else
wks.Select
Call YourProc
For Each myCell In Intersect(wks.UsedRange, wks.Columns(2)).Cells
If myCell.Interior.ColorIndex = 3 Then
oRow = oRow + 1
myCell.EntireRow.Copy _
Destination:=SumWks.Cells(oRow, "A")
End If
Next myCell
End If
Next wks
End Sub

sub YourProc()
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("C1").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
Columns("A:C").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.FormulaR1C1 = "=R[-1]C"
End Sub


I think I'd add a formula after all the copying is done:

=counta(B1:IV1) after inserting a new column A.

Then I could tell how many entries are in each row. (This'll work ok if no
cells are empty).


david shapiro wrote:

Dave,

Thanks for the VB code for extracting data from worksheets by color.

Rather than checking the entire worksheet cell by cell for colored
cells, I`m thinking it might be easier if the programme just checks the
second column of every row in the worksheet.

If it is red, then extract the entire row of cells of data and list all
the rows in the new worksheet. This would be done for all of the
worksheets in the workbook. So the new worksheet would contain all the
red rows from all the worksheets in the workbook.

All of rows in the worksheets have a standard number of columns (from
columns A to AB on the excel sheet). (If possible, it would be good if
the computer flagged when a worksheet did not have the standard A to AB
number of columns.)

How can I find out the right number for red in my color index?

I`ve also created the following code for preparing each of the
worksheets for the extraction process:

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("C1").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
Columns("A:C").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.FormulaR1C1 = "=R[-1]C"
End Sub

Would it be possible to alter the code so that it runs this procedure on
every worksheet in the workbook? And then add the extraction procedure
(which creates the new data sheet and extract the rows of data by color)
after this.

Overall, this is what the VB does:

1) It prepares the worksheets for the extraction process (this is done
for each worksheet in the workbook): the procedure for each worksheet
is above.

2) When all worksheets prepared, a new empty data sheet is created.

3) Search through each row of the worksheet for every row where the
second column is red. If column 2 of the row is red, extract the whole
row of cells and list in the new data sheet. Do procedure for all
worksheets.

4) New data sheet contains all rows in worksheets in workbook for which
the second column is red.

Hope the description isn`t too complicated. Thanks very much.

Dave

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

--

Dave Peterson

Dave,

It works great. Many thanks!!

Dave Shapiro



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Dave,

Had just wanted to thank you again for the program to pull out data from
a dataset based on color.

I also tried out your initial suggestion for doing this which was
(attached below). But somehow in creating it, there is always an error
which comes up at the line:
= Array("Sheet", "address", "value", "formula")
The whole line becomes red, and the error message is something referring
to "end of statement" or something like that.

Do you know what the problem might be and how to fix it?

Thanks.

Dave Shapiro

your original suggestion:

"Maybe something like this that loops through each cell in the usedrange
of each worksheet:"

Option Explicit
Sub testme01()

Dim wks As Worksheet
Dim SumWks As Worksheet
Dim myCell As Range
Dim oRow As Long

Set SumWks = Worksheets.Add
SumWks.Range("a1").Resize(1, 4).Value _
= Array("Sheet", "address", "value", "formula")

oRow = 1
For Each wks In ActiveWorkbook.Worksheets
If wks.Name = SumWks.Name Then
'do nothing
Else
With SumWks
For Each myCell In wks.UsedRange.Cells
If myCell.Interior.ColorIndex = 3 Then
oRow = oRow + 1
.Cells(oRow, "A").Value = "'" & wks.Name
.Cells(oRow, "B").Value = myCell.Address(0, 0)
.Cells(oRow, "C").Value = "'" & myCell.Value
.Cells(oRow, "D").Value = "'" & myCell.Formula
End If
Next myCell
End With
End If
Next wks
End Sub




*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!