Finding empty cells

[leimst]

I have a workbook with 10 worksheets (tabs) each with a Header Row with the
month of July dates across the top and a Header Column with other
information running down the side. What macro would search all 10 sheets
for the last date (column) that might have an entry from any of the rows,
search back from there through July 1st and identify all blank cells or
cells with a red "fill" and consolidate all of them on a new worksheet?

Thanks for any help,

Brian

 

[Joel]

Sub combinesheets()

First = True

For Each Sht In ThisWorkbook.Sheets
If First = True Then
'create new summary worksheet
Set SummarySht = Worksheets.Add(after:=Sheets(Sheets.Count))
'copy header Row to new sheet
Sht.Rows(1).Copy Destination = SummarySht.Rows(1)
NewRow = 2
First = False
End If
LastCol = Sht.Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Sht.Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 2 To LastRow
AddedRow = False
For ColCount = 2 To LastCol
If Sht.Cells(RowCount, ColCount) = "" Or _
Sht.Cells(RowCount, ColCount). _
Interior.ColorIndex <> xlNone Then

If AddedRow = False Then
'add header column
SummarySht.Range("A" & NewRow).Value = _
Sht.Range("A" & RowCount).Value
AddedRow = True
End If
If Sht.Cells(RowCount, ColCount) = "" Then
'Add X for empty cells
SummarySht.Cells(NewRow, ColCount) = "X"
Else
NewSht.Cells(RowCount, ColCount).Copy _
Destination:=SummarySht.Cells(NewRow, ColCount)
End If
End If
Next ColCount
If AddedRow = True Then
AddedRow = AddedRow + 1
End If
Next RowCount
Next Sht

End Sub

 

[leimst]

Joel,

Thanks for the response. This is my first attempt at using a macro though!
I took your script and copied and pasted it in as a module. I then wnet to
"Tools", "Macros", saw the "Combinesheets" macro and hit "Run". It came
back though and said "Compile Error: Variable Not Defined" and the "First =
True" statement at the top was grayed out. Am I doing something wrong in
loading or execution?

Thanks,

Brian

 

[Joel]

Depending on the way your workbook is set up you are required to define
variables. My workbook doesn't. I added the definitaions below


Sub combinesheets()
Dim First As Boolean
Dim Sht As Sheets
Dim SummarySht As Sheets
Dim NewRow As Long
Dim LastCol As Long
Dim LastRow As Long
Dim AddedRow As Long


First = True

For Each Sht In ThisWorkbook.Sheets
If First = True Then
'create new summary worksheet
Set SummarySht = Worksheets.Add(after:=Sheets(Sheets.Count))
'copy header Row to new sheet
Sht.Rows(1).Copy Destination = SummarySht.Rows(1)
NewRow = 2
First = False
End If
LastCol = Sht.Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Sht.Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 2 To LastRow
AddedRow = False
For ColCount = 2 To LastCol
If Sht.Cells(RowCount, ColCount) = "" Or _
Sht.Cells(RowCount, ColCount). _
Interior.ColorIndex <> xlNone Then

If AddedRow = False Then
'add header column
SummarySht.Range("A" & NewRow).Value = _
Sht.Range("A" & RowCount).Value
AddedRow = True
End If
If Sht.Cells(RowCount, ColCount) = "" Then
'Add X for empty cells
SummarySht.Cells(NewRow, ColCount) = "X"
Else
NewSht.Cells(RowCount, ColCount).Copy _
Destination:=SummarySht.Cells(NewRow, ColCount)
End If
End If
Next ColCount
If AddedRow = True Then
AddedRow = AddedRow + 1
End If
Next RowCount
Next Sht

End Sub

 

[leimst]

I've tried this again but am still getting a Compile Error. Any suggestions
on maybe some settings I should change?

Thanks,

Brian

 

[Joel]

I left a colon out of one statment. If there are additional problems let me
know which line has the error. It willusually be highlighted. Excel 2003
didn't give me a compiler error, but the line needed to be fixed.


from
Sht.Rows(1).Copy Destination=SummarySht.Rows(1)
to
Sht.Rows(1).Copy Destination:=SummarySht.Rows(1)

 

[leimst]

Hey Joel, I appreciate your working through this with me...

Now it says "Compile error: Method or data member not found" and shows the
following line with the ".Rows" grayed out in the SummarySht.Rows(1) part;

Sht.Rows(1).Copy Destination:=SummarySht.Rows(1)

Thanks,

Brian

 

[Joel]

Sorry. Don't understand what happened. I thought I changed these two lines
before my last posting. For some reason the wrong lines got posted.


from
Dim Sht As sheets
Dim SummarySht As sheets

to
Dim Sht As Worksheet
Dim SummarySht As Worksheet

 

[leimst]

Hey Joel,



I am using Excel 2003 also. I finally figured out how to turn off the
"Required Variable Declaration" feature in the Options so hopefully that
will help. On my last attempt at running the code, it returned a "Run-time
error '424': Object required" message and highlighted the following lines
of code in yellow;



NewSht.Cells(RowCount, ColCount).Copy _

Destination:=SummarySht.Cells(NewRow, ColCount)



At this point when I run the code, it is creating a summary sheet at the end
of the Workbook, the Header columns are all there and it is returning 1 line
of information from the first Worksheet in the Workbook where it found a
cell that was highlighted in red.



The code in its entirety as I am currently trying to run it is;



Sub combinesheets()
Dim First As Boolean
Dim Sht As Worksheet
Dim SummarySht As Worksheet
Dim NewRow As Long
Dim LastCol As Long
Dim LastRow As Long
Dim AddedRow As Long



First = True



For Each Sht In ThisWorkbook.Sheets
If First = True Then
'create new summary worksheet
Set SummarySht = Worksheets.Add(after:=Sheets(Sheets.Count))
'copy header Row to new sheet
Sht.Rows(1).Copy Destination: = SummarySht.Rows(1)
NewRow = 2
First = False
End If
LastCol = Sht.Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Sht.Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 2 To LastRow
AddedRow = False
For ColCount = 2 To LastCol
If Sht.Cells(RowCount, ColCount) = "" Or _
Sht.Cells(RowCount, ColCount). _
Interior.ColorIndex <> xlNone Then

If AddedRow = False Then
'add header column
SummarySht.Range("A" & NewRow).Value = _
Sht.Range("A" & RowCount).Value
AddedRow = True
End If
If Sht.Cells(RowCount, ColCount) = "" Then
'Add X for empty cells
SummarySht.Cells(NewRow, ColCount) = "X"
Else
NewSht.Cells(RowCount, ColCount).Copy _
Destination:=SummarySht.Cells(NewRow, ColCount)
End If
End If
Next ColCount
If AddedRow = True Then
AddedRow = AddedRow + 1
End If
Next RowCount
Next Sht

End Sub

 

[Joel]

The variable declaration actually would of shown the problems. If fixed two
problems

Sub combinesheets()
Dim First As Boolean
Dim Sht As Worksheet
Dim SummarySht As Worksheet
Dim NewRow As Long
Dim LastCol As Long
Dim LastRow As Long
Dim AddedRow As Long



First = True



For Each Sht In ThisWorkbook.Sheets
If First = True Then
'create new summary worksheet
Set SummarySht = Worksheets.Add(after:=Sheets(Sheets.Count))
'copy header Row to new sheet
Sht.Rows(1).Copy Destination:=SummarySht.Rows(1)
NewRow = 2
First = False
End If
LastCol = Sht.Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Sht.Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 2 To LastRow
AddedRow = False
For ColCount = 2 To LastCol
If Sht.Cells(RowCount, ColCount) = "" Or _
Sht.Cells(RowCount, ColCount). _
Interior.ColorIndex <> xlNone Then

If AddedRow = False Then
'add header column
SummarySht.Range("A" & NewRow).Value = _
Sht.Range("A" & RowCount).Value
AddedRow = True
End If
If Sht.Cells(RowCount, ColCount) = "" Then
'Add X for empty cells
SummarySht.Cells(NewRow, ColCount) = "X"
Else
Sht.Cells(RowCount, ColCount).Copy _
Destination:=SummarySht.Cells(NewRow, ColCount)
End If
End If
Next ColCount
If AddedRow = True Then
NewRow = NewRow + 1
End If
Next RowCount
Next Sht

End Sub

 

[leimst]

Joel,

Thanks for all of your help! That worked and identified blanks from every
sheet with an "X". It did return a few wierd things but I think I know why
and maybe trying to figure it out will help me to begin understanding this
VBA code "stuff" better.

Thanks again!

Brian