Help with code.

[Guest]

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

 

[Niek Otten]

<following code>

???????

--

Kind Regards,

Niek Otten

Microsoft MVP - Excel

 

[Guest]

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

 

[Tim Williams]

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

tim

 

[Tom Ogilvy]

Set lvrng = wks1.Range(strg, etrg)

For Each cell In lvtrg


notice the difference in spellin lvrng vice lvtrg

 

[Guest]

I corrected my spelling mistakes and I am still getting the object variable
or with block variable not set error. What am I doing wrong? The debugger
goes to this point in the code after the error.

 

[Tom Ogilvy]

You have multiple errors in your code:

For Each cell In lvrng
req = cell.Value

You have commented out ct, so its default value is zero. Therefore, if you
uncomment


'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


then make sure you uncomment the statements that set a value for ct

You may have more errors; I didn't note any.

 

[Guest]

Here is my code again with a few modifications and comments to explain what
I'm trying to do. I can't figure out why my code is not setting the
coltrgsdate and coltrgedate ranges. My guess is that I'm not setting a
source range or using the find function correctly. Please help.

Option Explicit
Global sdate As Date
Global edate As Date


Sub dostuff()
Dim name As String
Dim req As String
Dim srcName As Range
Dim srcDate As Range
Dim rowtrgname As Range
Dim coltrgsdate As Range
Dim coltrgedate 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


Set wks1 = Worksheets("IP LV Tracker")
'column B from B3 to B88 is the list of names
'I set srcName to the intersect with usedrange in case I need to add or
'delete names later.
Set srcName = Intersect(wks1.Columns("B"), wks1.UsedRange)
'Row 1 from C1 to DT1 are the calendar dates
'Again set to intersect with usedrange in case I want to change the
'range of dates. I'm not sure if I'm doing this correctly.
Set srcDate = Intersect(wks1.Rows(1), wks1.UsedRange)

'Loop through the input by selecting yes to make as many or as few
'inputs as required.
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.")
'Global variables sdate and edate are set by userform calendars to a
date.
startCalendar.Show
endCalendar.Show

Set rowtrgname = srcName.Find(name).EntireRow
'This, I think, is where the problem starts. When I set a watch
'for coltrgsdate and run the sub, it doesn't get set to anything.
'Therefore, I get the object variable not set error. I don't know
what
'I'm doing wrong.
Set coltrgsdate = srcDate.Find(sdate).EntireColumn
Set coltrgedate = srcDate.Find(edate).EntireColumn

Set strg = Intersect(rowtrgname, coltrgsdate)
Set etrg = Intersect(rowtrgname, coltrgedate)

'Here, I want to set a range from the start target(strg) to the end
'target(etrg).
Set lvrng = wks1.Range(strg, etrg)

For Each cell In lvrng
'I want to make the value of each cell in lvrng = req ie.LV or SL
Set cell.Value = req
'Select a case for coloring each cell based on value of req.
Select Case req
Case Is = "LV": color = 4
Case Is = "SL": color = 6
End Select
'color the cell.
cell.Interior.ColorIndex = color
Next cell

Loop

End Sub

 

[Tom Ogilvy]

Find has a hard time finding dates sometimes (in my experience); especially
if you don't manage the options in Find. So you need to see if the find was
successful and then possibly use Match to see if you can find the date.
Dim sStr as String


Set coltrgsdate = srcDate.Find(sDate)
If coltrgsdate Is Nothing Then
sStr = Format(sDate, "mm/dd/yyyy")
res = Application.Match(CLng(CDate(sStr)), srcDate, 0)
If Not IsError(res) Then
Set coltrgsdate = srcDate(1, res).EntireColumn
Else
MsgBox sStr & " , the start date not found, quitting"
Exit Sub
End If
Else
Set coltrgsdate = coltrgsdate.EntireColumn
End If

Set coltrgedate = srcDate.Find(eDate)
If coltrgedate Is Nothing Then
sStr = Format(eDate, "mm/dd/yyyy")
res = Application.Match(CLng(CDate(sStr)), srcDate, 0)
If Not IsError(res) Then
Set coltrgedate = srcDate(1, res).EntireColumn
Else
MsgBox sStr & " , the end date not found, quitting"
Exit Sub
End If
Else
Set coltrgedate = coltrgedate.EntireColumn
End If

Of course, if Find is failing, then you should get an error on
Set coltrgsdate = srcDate.Find(sDate).entirecolumn

since you Nothing doesn't have an entirecolumn

 

[Guest]

What do I set the variable res to?

Find has a hard time finding dates sometimes (in my experience); especially
if you don't manage the options in Find. So you need to see if the find was
successful and then possibly use Match to see if you can find the date.
Dim sStr as String


Set coltrgsdate = srcDate.Find(sDate)
If coltrgsdate Is Nothing Then
sStr = Format(sDate, "mm/dd/yyyy")
res = Application.Match(CLng(CDate(sStr)), srcDate, 0)
If Not IsError(res) Then
Set coltrgsdate = srcDate(1, res).EntireColumn
Else
MsgBox sStr & " , the start date not found, quitting"
Exit Sub
End If
Else
Set coltrgsdate = coltrgsdate.EntireColumn
End If

Set coltrgedate = srcDate.Find(eDate)
If coltrgedate Is Nothing Then
sStr = Format(eDate, "mm/dd/yyyy")
res = Application.Match(CLng(CDate(sStr)), srcDate, 0)
If Not IsError(res) Then
Set coltrgedate = srcDate(1, res).EntireColumn
Else
MsgBox sStr & " , the end date not found, quitting"
Exit Sub
End If
Else
Set coltrgedate = coltrgedate.EntireColumn
End If

Of course, if Find is failing, then you should get an error on
Set coltrgsdate = srcDate.Find(sDate).entirecolumn

since you Nothing doesn't have an entirecolumn

 

[Tom Ogilvy]

Dim res as Variant

Match returns an error value if there is no match, otherwise it returns a
long, so dim it as variant.

 

[Guest]

Awsome, that works great. Thank you very much.
Erik