VBA Excel

  • Thread starter Thread starter phong.lee
  • Start date Start date
P

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.
 
Have you looked into Conditional Formatting?







- Show quoted text -
Click to expand...

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
 
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
 
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 -
Click to expand...

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.
 
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.
 
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 -
Click to expand...

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?
 
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.
 
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 -
Click to expand...

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?
 
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 -
Click to expand...

Anyone can help? thanks.
 
Back
Top