Thread: Help with code.
View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Tim Williams Tim Williams is offline
external usenet poster
 
Posts: 1,588
Default Help with code.

....
For Each cell In lvtrg
set cell = req
....

tim


"Erik" wrote in message
...
"Erik" wrote:

I'm trying to get the following code to work, but I'm just not
smart enough
to do it. Can anyone tell me why I get object variable not set
error?
Thanks


I forgot to put the code in the first post. If follows now:

Private Sub Workbook_Open()

Dim name As String
Dim req As String
Dim sdate As String
Dim edate As String
'Dim ct As Integer
Dim srcName As Range
Dim srcDate As Range
Dim rowtrgname As Range
Dim strg As Range
Dim etrg As Range
Dim lvrng As Range
Dim cell As Range
Dim color As Integer
Dim wks1 As Worksheet

'ct = 1
Set wks1 = Worksheets("IP LV Tracker")
Set srcName = Intersect(wks1.Columns("B"), wks1.UsedRange)
Set srcDate = Intersect(wks1.Rows(1), wks1.UsedRange)

Do While MsgBox("Do you want to make an input?", vbYesNo) = vbYes

name = Application.InputBox("Enter the last name.")
req = Application.InputBox("Enter LV for leave or SL for
speclib.")
sdate = Application.InputBox("Enter the start date.")
edate = Application.InputBox("Enter the end date.")

Set rowtrgname = srcName.Find(name).EntireRow

Set strg = Intersect(rowtrgname, srcDate.Find( _
sdate, srcDate.Cells(1), _
xlValues).EntireColumn)
Set etrg = Intersect(rowtrgname, srcDate.Find( _
edate, srcDate.Cells(1), _
xlValues).EntireColumn)
Set lvrng = wks1.Range(strg, etrg)

For Each cell In lvtrg
cell = req
Select Case req
Case Is = "LV": color = 4
Case Is = "SL": color = 6
End Select
cell.Interior.ColorIndex = color
Next cell


'Worksheets("sheet2").Cells(ct, 1).Value = name
'Worksheets("sheet2").Cells(ct, 2).Value = req
'Worksheets("sheet2").Cells(ct, 3).Value = sdate
'Worksheets("sheet2").Cells(ct, 4).Value = edate

'ct = ct + 1
Loop

End Sub