VBA Excel

[phong.lee]

Hello all,

I'm new to this vba excel. I was wondering if anyone can give me some
insight on how i can go about in doing this.

I have an excel workbook that contains 2 spreadsheet. Sheet1 contains
data to use for sheet2. Sheet1 will have start date, end date, name,
country. Sheet2 contains a spreadsheet fill with different colors
base on the date range that is given. Right now it's manually being
done. Trying to figure out if there was a way for me to take the
start date and end date valuse and fill sheet2 with the respective
color for that range? Any advice will be appreciated. Thanks again.

 

[JW]

Have you looked into Conditional Formatting?

 

[phong.lee]

Have you looked into Conditional Formatting?







- Show quoted text -

Yeah i have, but i'm trying to put the code in a module and run a
process. Any kind of start will help or any samples where i can
modified the code will be great. thanks for the reponse JW

 

[Don Guillett]

Try this from your sheet where k1 is the start and L1 is the stop

Sub colorrng()
With Sheets("sheet9").Columns(1)
lr = .Cells(Rows.Count, 1).End(xlUp).Row
fd = .Find(Range("k1"), lookat:=xlWhole).Row
ed = .Find(Range("L1")).Row
.Range(.Cells(1, 1), .Cells(lr, 5)).Interior.ColorIndex = 0
.Range(.Cells(fd, 1), .Cells(ed, 5)).Interior.ColorIndex = 6
End With
End Sub

 

[phong.lee]

Try this from your sheet where k1 is the start and L1 is the stop

Sub colorrng()
With Sheets("sheet9").Columns(1)
lr = .Cells(Rows.Count, 1).End(xlUp).Row
fd = .Find(Range("k1"), lookat:=xlWhole).Row
ed = .Find(Range("L1")).Row
.Range(.Cells(1, 1), .Cells(lr, 5)).Interior.ColorIndex = 0
.Range(.Cells(fd, 1), .Cells(ed, 5)).Interior.ColorIndex = 6
End With
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software







- Show quoted text -

Hey don,

Do you know how i would do it for a date range from sheet 1.

i.e. sheet 1 has a date range in column 1 from 8/25/2007-09/01/2007
and in column 2 has a different data, and i want to fill sheet 2 with
a certain color if say column 2 contains color code blue and
respectively follow by date range? does that make sense thanks.

 

[Guest]

Are you trying to create a GANTT type layout on sheet2?

Do you have sequential dates at the top of sheet2 in row 1?

How do the dates at the top relate to the date ranges - are the dates at the
top sequential days? the range 1/1/2007 to 1/7/2007 would be filled in from
cells B1 to H1 for example.

Sub BuildColors()
Dim sh As Worksheet, r As Range
Dim rng As Range, cell As Range
Dim dt1 As Date, dt2 As Date
Dim res, res1

Set sh = Worksheets("Sheet2")
sh.Cells.Interior.ColorIndex = xlNone
r = sh.Range(sh.Range("A1"), sh.Range("B1").End(xlToRight))
With Worksheets("sheet1")
Set rng = .Range(.Range("A2"), .Range("A2").End(xlDown))
For Each cell In rng
dt1 = .Cells(cell.Row, 1)
dt2 = .Cells(cell.Row, 2)
res = Application.Match(CLng(dt1), r, 0)
res1 = Application.Match(CLng(dt2), r, 0)
If Not IsError(res) And Not IsError(res1) Then
sh.Range(sh.Cells(cell.Row, res), sh.Cells(cell.Row, res1)) _
.Interior.ColorIndex = 5
sh.Cells(cell.Row, 1).Value = cell.Offset(0, 2).Value _
& " (" & cell.Offset(0, 3).Value & ")"
End If
Next cell
End With

End Sub

If your sheet is set up as I describe and this is what you are trying to do
then
Test it on a copy of your workbook.

 

[phong.lee]

Are you trying to create a GANTT type layout on sheet2?

Do you have sequential dates at the top of sheet2 in row 1?

How do the dates at the top relate to the date ranges - are the dates at the
top sequential days? the range 1/1/2007 to 1/7/2007 would be filled in from
cells B1 to H1 for example.

Sub BuildColors()
Dim sh As Worksheet, r As Range
Dim rng As Range, cell As Range
Dim dt1 As Date, dt2 As Date
Dim res, res1

Set sh = Worksheets("Sheet2")
sh.Cells.Interior.ColorIndex = xlNone
r = sh.Range(sh.Range("A1"), sh.Range("B1").End(xlToRight))
With Worksheets("sheet1")
Set rng = .Range(.Range("A2"), .Range("A2").End(xlDown))
For Each cell In rng
dt1 = .Cells(cell.Row, 1)
dt2 = .Cells(cell.Row, 2)
res = Application.Match(CLng(dt1), r, 0)
res1 = Application.Match(CLng(dt2), r, 0)
If Not IsError(res) And Not IsError(res1) Then
sh.Range(sh.Cells(cell.Row, res), sh.Cells(cell.Row, res1)) _
.Interior.ColorIndex = 5
sh.Cells(cell.Row, 1).Value = cell.Offset(0, 2).Value _
& " (" & cell.Offset(0, 3).Value & ")"
End If
Next cell
End With

End Sub

If your sheet is set up as I describe and this is what you are trying to do
then
Test it on a copy of your workbook.

--
Regards,
Tom Ogilvy







- Show quoted text -

Hello tom,

I just try testing the code you have and i'm getting a run time error
91.

r = sh.range(sh.range("A1"), sh.range("B1").End(xlToRight))

That's the code that i'm getting the error at. Can you explain to me
the reason for the error just so i know for future reference. Thanks.

I enter in some test data in sheet 1.

Column A - Start date 01/01/2007
Column B - End Date 01/07/2007
Column C - Test Name
Column D - Test Name2
Column E - Color Phases

Sheet 2 is already set up with certain colors that have been filled in
manually.

let me see if i can clear this up a bit more. So what sheet 2 color
should fill would be say from 01/01/2007 - 01/07/2007 and the color
phase is blue from sheet 1. I guess there should be a range fill for
the first 5 days?

 

[Guest]

A typo.

set sh = worksheets("Sheet2")
set r = sh.range(sh.range("A1"), sh.range("B1").End(xlToRight))
? r.address
$A$1:$F$1


and to get the colorindex (a number between 1 and 56 inclusive) from column E

Sub BuildColors()
Dim sh As Worksheet, r As Range
Dim rng As Range, cell As Range
Dim dt1 As Date, dt2 As Date
Dim res, res1

Set sh = Worksheets("Sheet2")
' this line will clear colors in sheet2 so I commented it out.
'sh.Cells.Interior.ColorIndex = xlNone
set r = sh.Range(sh.Range("A1"), sh.Range("B1").End(xlToRight))
With Worksheets("sheet1")
Set rng = .Range(.Range("A2"), .Range("A2").End(xlDown))
For Each cell In rng
dt1 = .Cells(cell.Row, 1)
dt2 = .Cells(cell.Row, 2)
res = Application.Match(CLng(dt1), r, 0)
res1 = Application.Match(CLng(dt2), r, 0)
If Not IsError(res) And Not IsError(res1) Then
sh.Range(sh.Cells(cell.Row, res), sh.Cells(cell.Row, res1)) _
.Interior.ColorIndex = cell.offset(0,4).Value
sh.Cells(cell.Row, 1).Value = cell.Offset(0, 2).Value _
& " (" & cell.Offset(0, 3).Value & ")"
End If
Next cell
End With

End Sub

Again, this is a guess at what you want.

 

[phong.lee]

A typo.

set sh = worksheets("Sheet2")
set r = sh.range(sh.range("A1"), sh.range("B1").End(xlToRight))
? r.address
$A$1:$F$1

and to get the colorindex (a number between 1 and 56 inclusive) from column E

Sub BuildColors()
Dim sh As Worksheet, r As Range
Dim rng As Range, cell As Range
Dim dt1 As Date, dt2 As Date
Dim res, res1

Set sh = Worksheets("Sheet2")
' this line will clear colors in sheet2 so I commented it out.
'sh.Cells.Interior.ColorIndex = xlNone
set r = sh.Range(sh.Range("A1"), sh.Range("B1").End(xlToRight))
With Worksheets("sheet1")
Set rng = .Range(.Range("A2"), .Range("A2").End(xlDown))
For Each cell In rng
dt1 = .Cells(cell.Row, 1)
dt2 = .Cells(cell.Row, 2)
res = Application.Match(CLng(dt1), r, 0)
res1 = Application.Match(CLng(dt2), r, 0)
If Not IsError(res) And Not IsError(res1) Then
sh.Range(sh.Cells(cell.Row, res), sh.Cells(cell.Row, res1)) _
.Interior.ColorIndex = cell.offset(0,4).Value
sh.Cells(cell.Row, 1).Value = cell.Offset(0, 2).Value _
& " (" & cell.Offset(0, 3).Value & ")"
End If
Next cell
End With

End Sub

Again, this is a guess at what you want.

--
Regards,
Tom Ogilvy













- Show quoted text -

Thanks tom, here's another question if you can help me with. sorry
for the trouble. When the code DIM dt1 as date, i ran it through
debug and it only shows 12:00am instead of the date value, why does it
do that? I think that's why i'm also getting a run-time error of 5.
Invalid procedure call or argument. Is that true?

 

[phong.lee]

A typo.

set sh = worksheets("Sheet2")
set r = sh.range(sh.range("A1"), sh.range("B1").End(xlToRight))
? r.address
$A$1:$F$1

and to get the colorindex (a number between 1 and 56 inclusive) from column E

Sub BuildColors()
Dim sh As Worksheet, r As Range
Dim rng As Range, cell As Range
Dim dt1 As Date, dt2 As Date
Dim res, res1

Set sh = Worksheets("Sheet2")
' this line will clear colors in sheet2 so I commented it out.
'sh.Cells.Interior.ColorIndex = xlNone
set r = sh.Range(sh.Range("A1"), sh.Range("B1").End(xlToRight))
With Worksheets("sheet1")
Set rng = .Range(.Range("A2"), .Range("A2").End(xlDown))
For Each cell In rng
dt1 = .Cells(cell.Row, 1)
dt2 = .Cells(cell.Row, 2)
res = Application.Match(CLng(dt1), r, 0)
res1 = Application.Match(CLng(dt2), r, 0)
If Not IsError(res) And Not IsError(res1) Then
sh.Range(sh.Cells(cell.Row, res), sh.Cells(cell.Row, res1)) _
.Interior.ColorIndex = cell.offset(0,4).Value
sh.Cells(cell.Row, 1).Value = cell.Offset(0, 2).Value _
& " (" & cell.Offset(0, 3).Value & ")"
End If
Next cell
End With

End Sub

Again, this is a guess at what you want.

--
Regards,
Tom Ogilvy













- Show quoted text -

Anyone can help? thanks.