Looking for Macro Help: Zeroing Out Cells & Color Coding
Any help is appreciated.
I am running into trouble trying to write a Macro that does the following: * Affects all workbook tabs (i.e. worksheets). * Zeros out all numeric constants. * Color codes the following * Named cells (gray background) What I've got so far (see below) gives me the error "1004 Application-defined or object-defined error". I think that it has to do with not being able to get a proper range reference to loop over cells on a given worksheet but I am at a loss. Sub ColorCodeAndZeroOut() For i = 1 To Worksheets.Count On Error GoTo ErrorHandler For Each n In LastCell(Worksheets(i)).Cells If IsEmpty(n.Name.Name) Then n.Interior.ColorIndex = 0 'White Else n.Interior.ColorIndex = 15 'Gray End If If IsNumeric(n) And Not n.HasFormula Then If n.Value < 0 Then n.Value = 0 ProtectedCell: End If End If Next n ErrorHandler: If Err = 1005 Then Resume ProtectedCell Else MsgBox Err.Number & " " & Err.Description & " " & Err.Source End If Next i End Sub Function LastCell(ws As Worksheet) As Range Dim LastRow&, LastCol% ' Error-handling is here in case there is not any ' data in the worksheet On Error Resume Next With ws ' Find the last real row LastRow& = .Cells.Find(What:="*", _ SearchDirection:=xlPrevious, _ SearchOrder:=xlByRows).Row ' Find the last real column LastCol% = .Cells.Find(What:="*", _ SearchDirection:=xlPrevious, _ SearchOrder:=xlByColumns).Column End With ' Finally, initialize a Range object variable for ' the last populated row. Set LastCell = ws.Cells(LastRow&, LastCol%) End Function |
Looking for Macro Help: Zeroing Out Cells & Color Coding
Dim sh as Worksheet
Dim rng as Range dim nme as Name for each sh in ActiveWorkbook.Worksheets set rng = Nothing sh.Cells.Interior.ColorIndex = xlNone On Error Resume Next set rng = sh.Cells.SpecialCells(xlConstants,xlNumbers) On Error goto 0 if not rng is nothing then rng.Value = 0 end if Next For each nme in ActiveWorkbook.Names set rng = Nothing On Error Resume Next set rng = nme.RefersToRange On Error goto 0 if not rng is nothing then rng.Interior.ColorIndex = 15 end if Next -- Regards, Tom Ogilvy "orangepips" wrote in message oups.com... Any help is appreciated. I am running into trouble trying to write a Macro that does the following: * Affects all workbook tabs (i.e. worksheets). * Zeros out all numeric constants. * Color codes the following * Named cells (gray background) What I've got so far (see below) gives me the error "1004 Application-defined or object-defined error". I think that it has to do with not being able to get a proper range reference to loop over cells on a given worksheet but I am at a loss. Sub ColorCodeAndZeroOut() For i = 1 To Worksheets.Count On Error GoTo ErrorHandler For Each n In LastCell(Worksheets(i)).Cells If IsEmpty(n.Name.Name) Then n.Interior.ColorIndex = 0 'White Else n.Interior.ColorIndex = 15 'Gray End If If IsNumeric(n) And Not n.HasFormula Then If n.Value < 0 Then n.Value = 0 ProtectedCell: End If End If Next n ErrorHandler: If Err = 1005 Then Resume ProtectedCell Else MsgBox Err.Number & " " & Err.Description & " " & Err.Source End If Next i End Sub Function LastCell(ws As Worksheet) As Range Dim LastRow&, LastCol% ' Error-handling is here in case there is not any ' data in the worksheet On Error Resume Next With ws ' Find the last real row LastRow& = .Cells.Find(What:="*", _ SearchDirection:=xlPrevious, _ SearchOrder:=xlByRows).Row ' Find the last real column LastCol% = .Cells.Find(What:="*", _ SearchDirection:=xlPrevious, _ SearchOrder:=xlByColumns).Column End With ' Finally, initialize a Range object variable for ' the last populated row. Set LastCell = ws.Cells(LastRow&, LastCol%) End Function |
Looking for Macro Help: Zeroing Out Cells & Color Coding
Thanks that worked. I owe you a beer if you're ever in Baltimore.
Regards. Matthew Lesko |
All times are GMT +1. The time now is 08:48 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com