pboltonchina
01-19-2009, 08:38 AM
Hi everyone,
I?m running a macro that searches each sheet in a workbook for a shaded cell in column A and then selects an area from that cell and pastes it into a new sheet called List. My problem is that not all my worksheets have a shaded cell in column A and therefore there is nothing to copy. The macro runs great until it hits one of these sheets and it stops with the error message ?Object variable or With block variable not set?. What I want the macro to do is ignore this sheet if it doesn?t find the shaded cell and move onto the next worksheet until it completes the book.
Thanks for looking, here?s my code
Sub Generate_Repair_Kit_List()
'
'
' Clear or Add a Results sheet
If SheetExists("List") Then
Sheets("List").Activate
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "List"
End If
For Each ws In Sheets
ws.Activate
With Application.FindFormat.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
'Find the cells based on the search criteria.
If Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate Then
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Sheets("List").Activate
Range("C65366").End(xlUp).Offset(1, -2).Select
ActiveSheet.Paste
Columns("A:F").Select
Selection.Columns.AutoFit
Else:
End If
Next ws
End Sub
Private Function SheetExists(SheetName As String) As Boolean
' Returns TRUE if a sheet exists in the active workbook
Dim x As Worksheet
On Error Resume Next
Set x = ActiveWorkbook.Sheets(SheetName)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function
I?m running a macro that searches each sheet in a workbook for a shaded cell in column A and then selects an area from that cell and pastes it into a new sheet called List. My problem is that not all my worksheets have a shaded cell in column A and therefore there is nothing to copy. The macro runs great until it hits one of these sheets and it stops with the error message ?Object variable or With block variable not set?. What I want the macro to do is ignore this sheet if it doesn?t find the shaded cell and move onto the next worksheet until it completes the book.
Thanks for looking, here?s my code
Sub Generate_Repair_Kit_List()
'
'
' Clear or Add a Results sheet
If SheetExists("List") Then
Sheets("List").Activate
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "List"
End If
For Each ws In Sheets
ws.Activate
With Application.FindFormat.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
'Find the cells based on the search criteria.
If Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate Then
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Sheets("List").Activate
Range("C65366").End(xlUp).Offset(1, -2).Select
ActiveSheet.Paste
Columns("A:F").Select
Selection.Columns.AutoFit
Else:
End If
Next ws
End Sub
Private Function SheetExists(SheetName As String) As Boolean
' Returns TRUE if a sheet exists in the active workbook
Dim x As Worksheet
On Error Resume Next
Set x = ActiveWorkbook.Sheets(SheetName)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function