Color for multi range

[Chandrasheka]

Hi,

Please find the attached file. I am trying to fill color for ranges as show in sheet1.

Thanks

[Bob Phillips]

Public Sub ProcessData()
Dim Startrow As Long
Dim Lastrow As Long
Dim i As Long
Dim cell As Range

Application.ScreenUpdating = False

With ActiveSheet

Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Startrow = 2
For i = 2 To Lastrow

If Not IsNumeric(Cells(i, "A").Value2) Then

.Cells(Startrow, "A").Resize(i - Startrow + 1).Interior.ColorIndex = 6
i = i + 1
Startrow = i + 1
End If
Next i
End With

Application.ScreenUpdating = True
End Sub

[Chandrasheka]

Hi,

Thank you for quick reply. If first cell having string code is not working. I have made changes to excel file. Please check the file.

[Bob Phillips]

Public Sub ProcessData()
Dim Startrow As Long
Dim Lastrow As Long
Dim i As Long
Dim cell As Range

Application.ScreenUpdating = False

With ActiveSheet

Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Startrow = 2
For i = 2 To Lastrow

If Not IsNumeric(Cells(i, "A").Value2) Then

.Cells(Startrow, "A").Resize(i - Startrow + 1).Interior.ColorIndex = 6
Do While IsEmpty(.Cells(i + 1, "A").Value2) And i <= Lastrow

i = i + 1
Loop
Startrow = i + 1
End If
Next i
End With

Application.ScreenUpdating = True
End Sub

[Chandrasheka]

Hi,

Sorry again I am facing some problem. Please check the attached file.

Thank you

Chandra Shekar

[Chandrasheka]

Hi,

Thank you problem is solved.

Regards,

Chandra Shekar

[mdmackillop]

Please post your solution for the benefit of others.

[Chandrasheka]

This is the solution. Thank you all for your support.

Thanks

Chandra Shekar

Sub fill_color()
cnt_st = 0
cnt_ed = 0
For j = 1 To 27
If ThisWorkbook.Worksheets(1).Cells(j, 1) = "S" Then
st = j
cnt_st = 1
End If
If ThisWorkbook.Worksheets(1).Cells(j, 1) = "E" Then
ed = j
cnt_ed = 1
End If
If cnt_st = 1 And cnt_ed = 1 Then
a = ed - st + 1
ThisWorkbook.Worksheets(1).Cells(st, 1).Resize(a, 1).Interior.ColorIndex = 6
cnt_st = 0
cnt_ed = 0
End If

Next
End Sub