Simple but I can't get it to work? PLEASE help!!

N

Naji

I don't know why my code isn't working. I tried implementing some
examples I found on here after doing a search, but I received an Object
error. I have spent the past 2 hours trying to figure this out, so any
help would be appreciated. I am quite a newbie I suppose...All I'm
trying to do is as follows:

1)I need to find today's date in the range C3-BO3.
2)Once I found the cell with today's date, I need to set the cell below
it as the variable HMLoc .


It sounds simple but I tried using the Find method but got nowhere.

Please help! You will make my day!
 
N

Niek Otten

Is this a worksheet or VBA?

Post the code you tried, the inputs and what you saw happening when you
tried
 
N

Naji

This is a worksheet called "2 Months" in a workbook called "Forcast". I
just scrapped all my code, but I can re-do it if neccessary. It wasn't
working.
 
D

Dave O

This code worked for me:

Sub FindToday()
Dim rCell

Range("c3:bo3").Select
For Each rCell In Selection
If rCell.Value = Date Then Range(rCell.Address).Offset(1, 0).Formula
= "=HMLoc"
Next rCell

End Sub
 
N

Naji

OK here is my code as of now, but I get a Variable not defined error.
What do I set HMloc as?


Sub ColorHM()




Range("c3:bo3").Select
Dim rcell

For Each rcell In Selection
If rcell.Value = Date Then Range(rcell.Address).Offset(1, 0).Formula
= "=HMLoc"
Next rcell


Dim theRow As Integer
Dim theCol As Integer
Dim NumX As Single
Dim Color1 As Integer
Dim Color2 As Integer
Dim Color3 As Integer
Dim Color4 As Integer
Dim Color6 As Integer
Dim ColorB As Integer
Dim Prod01 As Single
Dim Prod02 As Single
Dim Prod03 As Single
Dim Prod04 As Single
Dim Prod06 As Single
Dim ProdBal As Single
Dim Fcst01 As Single
Dim Fcst02 As Single
Dim Fcst03 As Single
Dim Fcst04 As Single
Dim Fcst06 As Single
Dim FcstBal As Single
Dim theCell

Color1 = Range(LegendLoc).Offset(0, 0).Interior.ColorIndex
Color2 = Range(LegendLoc).Offset(1, 0).Interior.ColorIndex
Color3 = Range(LegendLoc).Offset(2, 0).Interior.ColorIndex
Color4 = Range(LegendLoc).Offset(3, 0).Interior.ColorIndex
Color6 = Range(LegendLoc).Offset(4, 0).Interior.ColorIndex
ColorB = Range(LegendLoc).Offset(5, 0).Interior.ColorIndex

Prod01 = Sheets("HM Calcs").Range("B6").Value
Prod02 = Sheets("HM Calcs").Range("C6").Value
Prod03 = Sheets("HM Calcs").Range("D6").Value
Prod04 = Sheets("HM Calcs").Range("E6").Value
Prod06 = Sheets("HM Calcs").Range("F6").Value
ProdBal = Sheets("HM Calcs").Range("G6").Value
Fcst01 = Sheets("HM Calcs").Range("H6").Value
Fcst02 = Sheets("HM Calcs").Range("I6").Value
Fcst03 = Sheets("HM Calcs").Range("J6").Value
Fcst04 = Sheets("HM Calcs").Range("K6").Value
Fcst06 = Sheets("HM Calcs").Range("L6").Value
FcstBal = Sheets("HM Calcs").Range("M6").Value

NumX = 0#

Range(hmloc).Select
For Each theCell In Selection

For theCol = 0 To 55
For theRow = 0 To 2

If theCell.Offset(theRow, theCol).Value = "X" Or
theCell.Offset(theRow, theCol).Value = "1/2" Or theCell.Offset(theRow,
theCol).Value = "Y" Then
If theCell.Offset(theRow, theCol).Value = "X" Then
NumX = NumX + 1
ElseIf theCell.Offset(theRow, theCol).Value = "1/2" Then
NumX = NumX + 0.5
ElseIf theCell.Offset(theRow, theCol).Value = "Y" Then
NumX = NumX + 0.9574
End If
With theCell.Offset(theRow, theCol).Interior
.Pattern = xlSolid
If NumX > FcstBal Then
.Pattern = xlAutomatic
.ColorIndex = None
ElseIf NumX > Fcst06 Then
.ColorIndex = ColorB
ElseIf NumX > Fcst04 Then
.ColorIndex = Color6
ElseIf NumX > Fcst03 Then
.ColorIndex = Color4
ElseIf NumX > Fcst02 Then
.ColorIndex = Color3
ElseIf NumX > Fcst01 Then
.ColorIndex = Color2
ElseIf NumX > ProdBal Then
.ColorIndex = Color1
ElseIf NumX > Prod06 Then
.ColorIndex = ColorB
ElseIf NumX > Prod04 Then
.ColorIndex = Color6
ElseIf NumX > Prod03 Then
.ColorIndex = Color4
ElseIf NumX > Prod02 Then
.ColorIndex = Color3
ElseIf NumX > Prod01 Then
.ColorIndex = Color2
Else
.ColorIndex = Color1
End If
End With
Else
With theCell.Offset(theRow, theCol).Interior
.Pattern = xlAutomatic
.ColorIndex = None
End With
End If

Next theRow
Next theCol

Next theCell
Range("A1").Select

End Sub
 
N

Naji

Range(hmloc).Select <--- this line is erroring out with a "variable
not defined" error.
 
N

Naji

I figured it out. For reference, here is my code:


Sub ColorHM()

Dim theRow As Integer
Dim theCol As Integer
Dim NumX As Single
Dim Color1 As Integer
Dim Color2 As Integer
Dim Color3 As Integer
Dim Color4 As Integer
Dim Color6 As Integer
Dim ColorB As Integer
Dim Prod01 As Single
Dim Prod02 As Single
Dim Prod03 As Single
Dim Prod04 As Single
Dim Prod06 As Single
Dim ProdBal As Single
Dim Fcst01 As Single
Dim Fcst02 As Single
Dim Fcst03 As Single
Dim Fcst04 As Single
Dim Fcst06 As Single
Dim FcstBal As Single
Dim theCell

Color1 = Range(LegendLoc).Offset(0, 0).Interior.ColorIndex
Color2 = Range(LegendLoc).Offset(1, 0).Interior.ColorIndex
Color3 = Range(LegendLoc).Offset(2, 0).Interior.ColorIndex
Color4 = Range(LegendLoc).Offset(3, 0).Interior.ColorIndex
Color6 = Range(LegendLoc).Offset(4, 0).Interior.ColorIndex
ColorB = Range(LegendLoc).Offset(5, 0).Interior.ColorIndex

Prod01 = Sheets("HM Calcs").Range("B6").Value
Prod02 = Sheets("HM Calcs").Range("C6").Value
Prod03 = Sheets("HM Calcs").Range("D6").Value
Prod04 = Sheets("HM Calcs").Range("E6").Value
Prod06 = Sheets("HM Calcs").Range("F6").Value
ProdBal = Sheets("HM Calcs").Range("G6").Value
Fcst01 = Sheets("HM Calcs").Range("H6").Value
Fcst02 = Sheets("HM Calcs").Range("I6").Value
Fcst03 = Sheets("HM Calcs").Range("J6").Value
Fcst04 = Sheets("HM Calcs").Range("K6").Value
Fcst06 = Sheets("HM Calcs").Range("L6").Value
FcstBal = Sheets("HM Calcs").Range("M6").Value

NumX = 0#


Dim rCell


Range("c3:bo3").Select
For Each rCell In Selection
If rCell.Value = Date Then Range(rCell.Address).Offset(1, 0).Activate

Next rCell


For Each rCell In Selection

For theCol = 0 To 35
For theRow = 0 To 2

If rCell.Offset(theRow, theCol).Value = "X" Or rCell.Offset(theRow,
theCol).Value = "1/2" Or rCell.Offset(theRow, theCol).Value = "Y" Then
If rCell.Offset(theRow, theCol).Value = "X" Then
NumX = NumX + 1
ElseIf rCell.Offset(theRow, theCol).Value = "1/2" Then
NumX = NumX + 0.5
ElseIf rCell.Offset(theRow, theCol).Value = "Y" Then
NumX = NumX + 0.9574
End If
With rCell.Offset(theRow, theCol).Interior
.Pattern = xlSolid
If NumX > FcstBal Then
.Pattern = xlAutomatic
.ColorIndex = None
ElseIf NumX > Fcst06 Then
.ColorIndex = ColorB
ElseIf NumX > Fcst04 Then
.ColorIndex = Color6
ElseIf NumX > Fcst03 Then
.ColorIndex = Color4
ElseIf NumX > Fcst02 Then
.ColorIndex = Color3
ElseIf NumX > Fcst01 Then
.ColorIndex = Color2
ElseIf NumX > ProdBal Then
.ColorIndex = Color1
ElseIf NumX > Prod06 Then
.ColorIndex = ColorB
ElseIf NumX > Prod04 Then
.ColorIndex = Color6
ElseIf NumX > Prod03 Then
.ColorIndex = Color4
ElseIf NumX > Prod02 Then
.ColorIndex = Color3
ElseIf NumX > Prod01 Then
.ColorIndex = Color2
Else
.ColorIndex = Color1
End If
End With
Else
With rCell.Offset(theRow, theCol).Interior
.Pattern = xlAutomatic
.ColorIndex = None
End With
End If

Next theRow
Next theCol

Next rCell
Range("A1").Select

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top