Finding empty cells
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 |
Finding empty cells
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" wrote: 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 |
Finding empty cells
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" wrote in message ... 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" wrote: 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 |
Finding empty cells
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" wrote: 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" wrote in message ... 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" wrote: 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 |
Finding empty cells
I've tried this again but am still getting a Compile Error. Any suggestions
on maybe some settings I should change? Thanks, Brian "Joel" wrote in message ... 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" wrote: 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" wrote in message ... 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" wrote: 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 |
Finding empty cells
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" wrote: I've tried this again but am still getting a Compile Error. Any suggestions on maybe some settings I should change? Thanks, Brian "Joel" wrote in message ... 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" wrote: 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" wrote in message ... 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" wrote: 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 |
Finding empty cells
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" wrote in message ... 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" wrote: I've tried this again but am still getting a Compile Error. Any suggestions on maybe some settings I should change? Thanks, Brian "Joel" wrote in message ... 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" wrote: 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" wrote in message ... 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" wrote: 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 |
Finding empty cells
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" wrote: 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" wrote in message ... 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" wrote: I've tried this again but am still getting a Compile Error. Any suggestions on maybe some settings I should change? Thanks, Brian "Joel" wrote in message ... 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" wrote: 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" wrote in message ... 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" wrote: 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 |
Finding empty cells
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" wrote in message ... 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" wrote: 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" wrote in message ... 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" wrote: I've tried this again but am still getting a Compile Error. Any suggestions on maybe some settings I should change? Thanks, Brian "Joel" wrote in message ... 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" wrote: 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" wrote in message ... 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" wrote: 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 |
Finding empty cells
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" wrote: 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" wrote in message ... 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" wrote: 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" wrote in message ... 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" wrote: I've tried this again but am still getting a Compile Error. Any suggestions on maybe some settings I should change? Thanks, Brian "Joel" wrote in message ... 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" wrote: 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" wrote in message ... 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" wrote: 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 |
Finding empty cells
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 "Joel" wrote in message ... 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" wrote: 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" wrote in message ... 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" wrote: 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" wrote in message ... 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" wrote: I've tried this again but am still getting a Compile Error. Any suggestions on maybe some settings I should change? Thanks, Brian "Joel" wrote in message ... 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" wrote: 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" wrote in message ... 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" wrote: 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 |
All times are GMT +1. The time now is 02:49 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com