close

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!Is this a worksheet or VBA?

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

--
Kind regards,

Niek Ottenquot;Najiquot; gt; wrote in message oups.com...
gt;I don't know why my code isn't working. I tried implementing some
gt; examples I found on here after doing a search, but I received an Object
gt; error. I have spent the past 2 hours trying to figure this out, so any
gt; help would be appreciated. I am quite a newbie I suppose...All I'm
gt; trying to do is as follows:
gt;
gt; 1)I need to find today's date in the range C3-BO3.
gt; 2)Once I found the cell with today's date, I need to set the cell below
gt; it as the variable HMLoc .
gt;
gt;
gt; It sounds simple but I tried using the Find method but got nowhere.
gt;
gt; Please help! You will make my day!
gt;
This is a worksheet called quot;2 Monthsquot; in a workbook called quot;Forcastquot;. I
just scrapped all my code, but I can re-do it if neccessary. It wasn't
working.This code worked for me:

Sub FindToday()
Dim rCell

Range(quot;c3:bo3quot;).Select
For Each rCell In Selection
If rCell.Value = Date Then Range(rCell.Address).Offset(1, 0).Formula
= quot;=HMLocquot;
Next rCell

End SubOK here is my code as of now, but I get a Variable not defined error.
What do I set HMloc as?Sub ColorHM()

Range(quot;c3:bo3quot;).Select
Dim rcell

For Each rcell In Selection
If rcell.Value = Date Then Range(rcell.Address).Offset(1, 0).Formula
= quot;=HMLocquot;
Next rcellDim 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(quot;HM Calcsquot;).Range(quot;B6quot;).Value
Prod02 = Sheets(quot;HM Calcsquot;).Range(quot;C6quot;).Value
Prod03 = Sheets(quot;HM Calcsquot;).Range(quot;D6quot;).Value
Prod04 = Sheets(quot;HM Calcsquot;).Range(quot;E6quot;).Value
Prod06 = Sheets(quot;HM Calcsquot;).Range(quot;F6quot;).Value
ProdBal = Sheets(quot;HM Calcsquot;).Range(quot;G6quot;).Value
Fcst01 = Sheets(quot;HM Calcsquot;).Range(quot;H6quot;).Value
Fcst02 = Sheets(quot;HM Calcsquot;).Range(quot;I6quot;).Value
Fcst03 = Sheets(quot;HM Calcsquot;).Range(quot;J6quot;).Value
Fcst04 = Sheets(quot;HM Calcsquot;).Range(quot;K6quot;).Value
Fcst06 = Sheets(quot;HM Calcsquot;).Range(quot;L6quot;).Value
FcstBal = Sheets(quot;HM Calcsquot;).Range(quot;M6quot;).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 = quot;Xquot; Or
theCell.Offset(theRow, theCol).Value = quot;1/2quot; Or theCell.Offset(theRow,
theCol).Value = quot;Yquot; Then
If theCell.Offset(theRow, theCol).Value = quot;Xquot; Then
NumX = NumX 1
ElseIf theCell.Offset(theRow, theCol).Value = quot;1/2quot; Then
NumX = NumX 0.5
ElseIf theCell.Offset(theRow, theCol).Value = quot;Yquot; Then
NumX = NumX 0.9574
End If
With theCell.Offset(theRow, theCol).Interior
.Pattern = xlSolid
If NumX gt; FcstBal Then
.Pattern = xlAutomatic
.ColorIndex = None
ElseIf NumX gt; Fcst06 Then
.ColorIndex = ColorB
ElseIf NumX gt; Fcst04 Then
.ColorIndex = Color6
ElseIf NumX gt; Fcst03 Then
.ColorIndex = Color4
ElseIf NumX gt; Fcst02 Then
.ColorIndex = Color3
ElseIf NumX gt; Fcst01 Then
.ColorIndex = Color2
ElseIf NumX gt; ProdBal Then
.ColorIndex = Color1
ElseIf NumX gt; Prod06 Then
.ColorIndex = ColorB
ElseIf NumX gt; Prod04 Then
.ColorIndex = Color6
ElseIf NumX gt; Prod03 Then
.ColorIndex = Color4
ElseIf NumX gt; Prod02 Then
.ColorIndex = Color3
ElseIf NumX gt; 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(quot;A1quot;).Select

End SubRange(hmloc).Select lt;--- this line is erroring out with a quot;variable
not definedquot; error.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(quot;HM Calcsquot;).Range(quot;B6quot;).Value
Prod02 = Sheets(quot;HM Calcsquot;).Range(quot;C6quot;).Value
Prod03 = Sheets(quot;HM Calcsquot;).Range(quot;D6quot;).Value
Prod04 = Sheets(quot;HM Calcsquot;).Range(quot;E6quot;).Value
Prod06 = Sheets(quot;HM Calcsquot;).Range(quot;F6quot;).Value
ProdBal = Sheets(quot;HM Calcsquot;).Range(quot;G6quot;).Value
Fcst01 = Sheets(quot;HM Calcsquot;).Range(quot;H6quot;).Value
Fcst02 = Sheets(quot;HM Calcsquot;).Range(quot;I6quot;).Value
Fcst03 = Sheets(quot;HM Calcsquot;).Range(quot;J6quot;).Value
Fcst04 = Sheets(quot;HM Calcsquot;).Range(quot;K6quot;).Value
Fcst06 = Sheets(quot;HM Calcsquot;).Range(quot;L6quot;).Value
FcstBal = Sheets(quot;HM Calcsquot;).Range(quot;M6quot;).Value

NumX = 0#Dim rCellRange(quot;c3:bo3quot;).Select
For Each rCell In Selection
If rCell.Value = Date Then Range(rCell.Address).Offset(1, 0).Activate

Next rCellFor Each rCell In Selection

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

If rCell.Offset(theRow, theCol).Value = quot;Xquot; Or rCell.Offset(theRow,
theCol).Value = quot;1/2quot; Or rCell.Offset(theRow, theCol).Value = quot;Yquot; Then
If rCell.Offset(theRow, theCol).Value = quot;Xquot; Then
NumX = NumX 1
ElseIf rCell.Offset(theRow, theCol).Value = quot;1/2quot; Then
NumX = NumX 0.5
ElseIf rCell.Offset(theRow, theCol).Value = quot;Yquot; Then
NumX = NumX 0.9574
End If
With rCell.Offset(theRow, theCol).Interior
.Pattern = xlSolid
If NumX gt; FcstBal Then
.Pattern = xlAutomatic
.ColorIndex = None
ElseIf NumX gt; Fcst06 Then
.ColorIndex = ColorB
ElseIf NumX gt; Fcst04 Then
.ColorIndex = Color6
ElseIf NumX gt; Fcst03 Then
.ColorIndex = Color4
ElseIf NumX gt; Fcst02 Then
.ColorIndex = Color3
ElseIf NumX gt; Fcst01 Then
.ColorIndex = Color2
ElseIf NumX gt; ProdBal Then
.ColorIndex = Color1
ElseIf NumX gt; Prod06 Then
.ColorIndex = ColorB
ElseIf NumX gt; Prod04 Then
.ColorIndex = Color6
ElseIf NumX gt; Prod03 Then
.ColorIndex = Color4
ElseIf NumX gt; Prod02 Then
.ColorIndex = Color3
ElseIf NumX gt; 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(quot;A1quot;).Select

End Sub

全站熱搜
創作者介紹
創作者 software 的頭像
software

software

software 發表在 痞客邦 留言(0) 人氣()