Make code shorter

**Aquila** · 03-17-2010, 10:38 PM

Hello there,

Can somebody help me out with shrotening following code please? Can't find a solution.

Code:

Sub lineoutcoloring()

    If Sheets("Shiftrapport").Range("E6").Value = "" Then
    Range("A6:X10").FormatConditions.Delete
    Range("A6:X10").Interior.Color = RGB(0, 0, 0)
    Range("A6:X10").Font.Color = RGB(0, 0, 0)
    Range("A6:X10").Borders.ColorIndex = xlAutomatic
    End If
    If Sheets("Shiftrapport").Range("E11").Value = "" Then
    Range("A11:X15").FormatConditions.Delete
    Range("A11:X15").Interior.Color = RGB(0, 0, 0)
    Range("A11:X15").Font.Color = RGB(0, 0, 0)
    Range("A11:X15").Borders.ColorIndex = xlAutomatic
    End If
    If Sheets("Shiftrapport").Range("E16").Value = "" Then
    Range("A16:X20").FormatConditions.Delete
    Range("A16:X20").Interior.Color = RGB(0, 0, 0)
    Range("A16:X20").Font.Color = RGB(0, 0, 0)
    Range("A16:X20").Borders.ColorIndex = xlAutomatic
    End If
    If Sheets("Shiftrapport").Range("E21").Value = "" Then
    Range("A21:X25").FormatConditions.Delete
    Range("A21:X25").Interior.Color = RGB(0, 0, 0)
    Range("A21:X25").Font.Color = RGB(0, 0, 0)
    Range("A21:X25").Borders.ColorIndex = xlAutomatic
    End If
    If Sheets("Shiftrapport").Range("E26").Value = "" Then
    Range("A26:X30").FormatConditions.Delete
    Range("A26:X30").Interior.Color = RGB(0, 0, 0)
    Range("A26:X30").Font.Color = RGB(0, 0, 0)
    Range("A26:X30").Borders.ColorIndex = xlAutomatic
    End If
    If Sheets("Shiftrapport").Range("E31").Value = "" Then
    Range("A31:X35").FormatConditions.Delete
    Range("A31:X35").Interior.Color = RGB(0, 0, 0)
    Range("A31:X35").Font.Color = RGB(0, 0, 0)
    Range("A31:X35").Borders.ColorIndex = xlAutomatic
    End If
    If Sheets("Shiftrapport").Range("E36").Value = "" Then
    Range("A36:X40").FormatConditions.Delete
    Range("A36:X40").Interior.Color = RGB(0, 0, 0)
    Range("A36:X40").Font.Color = RGB(0, 0, 0)
    Range("A36:X40").Borders.ColorIndex = xlAutomatic
    End If
    If Sheets("Shiftrapport").Range("E41").Value = "" Then
    Range("A41:X45").FormatConditions.Delete
    Range("A41:X45").Interior.Color = RGB(0, 0, 0)
    Range("A41:X45").Font.Color = RGB(0, 0, 0)
    Range("A41:X45").Borders.ColorIndex = xlAutomatic
    End If
    If Sheets("Shiftrapport").Range("E46").Value = "" Then
    Range("A46:X50").FormatConditions.Delete
    Range("A46:X50").Interior.Color = RGB(0, 0, 0)
    Range("A46:X50").Font.Color = RGB(0, 0, 0)
    Range("A46:X50").Borders.ColorIndex = xlAutomatic
    End If
    
End Sub

Many thanks!

Aquila

**rylo** · 03-17-2010, 11:18 PM

Hi

How about

Code:

For i = 6 To 46 Step 5
    If Cells(i, "E").Value = "" Then
      Set rng = Cells(i, "A").Resize(5, 24)
      rng.FormatConditions.Delete
      rng.Interior.Color = RGB(0, 0, 0)
      rng.Font.Color = RGB(0, 0, 0)
      rng.Borders.ColorIndex = xlAutomatic
    End If
  Next i

rylo

**mdbct** · 03-17-2010, 11:26 PM

Try this.

Code:

Sub lineoutcoloring()
Dim i As Integer, rng As Range
For i = 6 To 46 Step 5

If Sheets("Shiftrapport").Range("E" & i).Value = "" Then
Set rng = Range(Sheets("Shiftrapport").Range("E" & i).Offset(0, -4), _
        Sheets("Shiftrapport").Range("E" & i).Offset(4, 19))
rng.Select
With rng
    .FormatConditions.Delete
    .Interior.Color = RGB(0, 0, 0)
    .Font.Color = RGB(0, 0, 0)
    .Borders.ColorIndex = xlAutomatic
End With
Set rng = Nothing
End If
Next
End Sub

**teylyn** · 03-17-2010, 11:27 PM

maybe like this:

Code:

Sub lineoutcoloring()
Dim cCell As Range, i As Integer
For i = 6 To 46 Step 5
    Set cCell = Sheets("Shiftrapport").Range("E" & i)
    If cCell.Value = "" Then
        With Range("A" & i & ":X" & i + 4)
            .FormatConditions.Delete
            .Interior.Color = RGB(0, 0, 0)
            .Font.Color = RGB(0, 0, 0)
            .Borders.ColorIndex = xlAutomatic
        End With
    End If
Next i
End Sub

**Aquila** · 03-17-2010, 11:49 PM

Whow...

Thank you guys for quick response!!
rylo and teylyn your code works fine.
mdbct you code works but the range is not ok.

Anyway many thanks for the small code!
Problem solved

grts
Aquila

**Aquila** · 03-18-2010, 12:09 AM

Hello,

one more question about this,

I drawed line's in the ranges and also want them to change color.
How can i reach them? i've tried many ways but always i get an error massage.
.drawing.color
.lines.color
...?

Thanks