creating rows of colored cells from adjacent numbers

[Roger on Excel]

Hi ,

I have a column of numbers :

3
2
4

I want to make the corresponding number of adjacent cells appeared colored.
For example next to the "3" would be three red cells, next to "2", two red
cells, etc.

However I would like the colored cells to start after the previous columns
colored cells so that a Gantt chart effect is provided.

Can anyone help?

Thanks,

Roger

 

[Bernie Deitrick]

Roger,

Select the cells with the numbers, and run this

Sub RogerGantt()
Dim i As Integer
Dim t As Integer
Dim myCell As Range

t = 0
For Each myCell In Selection
For i = 1 To myCell.Value
t = t + 1
myCell.Offset(0, t).Interior.ColorIndex = 3
Next i
Next myCell

End Sub

HTH,
Bernie
MS Excel MVP

 

[Roger on Excel]

Bernie,

Thanks - this is excellent !!

By the way, how would one add a outline border to the colored cells so they
look like enclosed rectangles?

Also how would one automatically have the code select the numbered cells so
that a button could be pushed and the macro would select all number cells in
that column?

Thanks so much for your help

Best regards,

Roger

 

[Bernie Deitrick]

Roger,

Sub RogerGantt2()
Dim i As Integer
Dim t As Integer
Dim myCell As Range
Dim myA As Variant
Dim myLS As Variant
Dim myCol As Integer
Dim myRow As Long

myA = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)

myCol = 2 ' to do numbers in column B
myRow = 2 'Starting in Row 2

t = 1
For Each myCell In Range(Cells(myRow, myCol), Cells(Rows.Count,
myCol).End(xlUp))
i = myCell.Value
If i <> 0 Then
With myCell.Offset(0, t).Resize(1, i)
.Interior.ColorIndex = 3
For Each myLS In myA
With .Borders(myLS)
.LineStyle = xlContinuous
.Weight = xlThin ' or xlMedium
.ColorIndex = xlAutomatic
End With
Next myLS
End With
t = t + i
End If
Next myCell

End Sub

HTH,
Bernie
MS Excel MVP

 

[Roger on Excel]

Berinie,

This is excellent - thanyou so much for your help

Best regards,

Roger

 

[Roger on Excel]

Bernie, ive utilized your code in my spreadsheet, however im having a "type
mismatch" problem with the formulas in the cells with the numbers.

Can you help?

Roger

 

[Bernie Deitrick]

Roger,

What line does it fail on?

Anyway, try changing

i = myCell.Value

to

i = CInt(myCell.Value)

Your values may be strings...

Bernie

 

[Roger on Excel]

Hi Bernie,

Thanks for getting back to me.

That does appear to be the problem line of code.

I have the following formula delivering results to the number column.

=IF(LEFT(B5,1)="b",Summary!B29,IF(LEFT(B5,1)="s",Summary!B30,""))

I make a cell in the number column equal the cell with the formula above and
likewise for other numbers down the column.

The code works fine when a number is delivered by this formula, however it
grinds to a halt when it delivers the blank.

Ive tried

=IF(LEFT(B5,1)="b",Summary!B29,IF(LEFT(B5,1)="s",Summary!B30,0))

But this doesnt work either.

I also tried to substitute the amendment you suggested, however it still
doesnt work.

An alternative will be for me to have a userform read the numbers from the
formula cells and then deliver actual integers to the number column, but this
would be a drastic solution.

What do you think?

Best regards,

Roger

 

[Bernie Deitrick]

Roger,

Just do a check that the value is numeric:

Option Explicit
Sub RogerGantt3()
Dim i As Integer
Dim t As Integer
Dim myCell As Range
Dim myA As Variant
Dim myLS As Variant
Dim myCol As Integer
Dim myRow As Long

myA = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)

myCol = 2 ' to do numbers in column B
myRow = 2 'Starting in Row 2

t = 1
For Each myCell In Range(Cells(myRow, myCol), _
Cells(Rows.Count, myCol).End(xlUp))
If IsNumeric(myCell.Value) Then
i = myCell.Value
If i <> 0 Then
With myCell.Offset(0, t).Resize(1, i)
.Interior.ColorIndex = 3
For Each myLS In myA
With .Borders(myLS)
.LineStyle = xlContinuous
.Weight = xlThin ' or xlMedium
.ColorIndex = xlAutomatic
End With
Next myLS
End With
t = t + i
End If
End If
Next myCell

End Sub

HTH,
Bernie
MS Excel MVP