This is the code that I created to

[dyana]

This is the code that I created to try to shade columns, representing months, within each row based on the combination of the leadtime and a 2-digit month code.

The objective:
When looking at the 2-digit code for each row, start shading the month (corresponding column "1" for Jan, "2" for Feb. etc.) designated and stop shading based on the lead time shown in days. For example, if the 2-digit code is "32" representing "December" and the lead time if "100" for days, start shading at the 12th column through the 15th columns (4 columns over). The 4 columns results from the 100 days lead time which fall within the fourth month (100 days / 30 days = 3.33 months)

The second number of the two-digit month code designates the month with a couple of exceptions. For example, the 2-digit code of "24" having the second number of "4" represents "April". This format follows until the months of November or December which need the full 2-digit month code of "11" or "31" for Nov. and "12" or "32" for Dec.


Problem:
The below code works until the 2-digit code EQUATES TO July, August, September, October, November or December when the second digit of the 2-digit month code is "7", "8", "9", "0" or the full 2-digit code is "11", "31", "12", "32" for November and December. When the 2-digit code falls within these parametersm, it results in no coding.

I have tried so many things to get this to work with no improvement. I'm in a HUGE BIND, any ASSISTANCE is APPRECIATED


Code Below:
Case "1" through "6" have the same code therfore you don't need to review when attempting to follow the code.

Sub ColorShade()
Dim myRng As Range, myRow As Integer, myCol As Integer
Dim myDuration As Single, myLeadDate As Single, rtCol As Integer
Dim offSetCell As Integer, myRightVal As Integer

Sheets("sheet1&quot.Select
Sheets("sheet1&quot.Range("ba3&quot.Select
myRow = ActiveCell.Row
myCol = ActiveCell.Column
offSetCell = 1
Set myRng = ActiveSheet.Cells(myRow, myCol)

Do While myRng <> &quot;&quot;

myLeadDate = ActiveSheet.Cells(myRow, myCol + 1)


If myLeadDate Mod 30 = 0 Then
myDuration = (myLeadDate \ 30)
Else
myDuration = (myLeadDate \ 30) + 1
End If
myRightVal = Right(myRng.Value, 1)

Select Case myRightVal
Case &quot;1&quot;
ActiveSheet.Cells(myRow, (myCol + myRightVal + offSetCell)).Select
rtCol = ActiveCell.Column
ActiveSheet.Range(Cells(myRow, rtCol), Cells(myRow, rtCol + myDuration - 1)).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With

Case &quot;2&quot;
ActiveSheet.Cells(myRow, (myCol + myRightVal + offSetCell)).Select
rtCol = ActiveCell.Column
ActiveSheet.Range(Cells(myRow, rtCol), Cells(myRow, rtCol + myDuration - 1)).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With

Case &quot;3&quot;
ActiveSheet.Cells(myRow, (myCol + myRightVal + offSetCell)).Select
rtCol = ActiveCell.Column
ActiveSheet.Range(Cells(myRow, rtCol), Cells(myRow, rtCol + myDuration - 1)).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With

Case &quot;4&quot;
ActiveSheet.Cells(myRow, (myCol + myRightVal + offSetCell)).Select
rtCol = ActiveCell.Column
ActiveSheet.Range(Cells(myRow, rtCol), Cells(myRow, rtCol + myDuration - 1)).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With

Case &quot;5&quot;
ActiveSheet.Cells(myRow, (myCol + myRightVal + offSetCell)).Select
rtCol = ActiveCell.Column
ActiveSheet.Range(Cells(myRow, rtCol), Cells(myRow, rtCol + myDuration - 1)).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With

Case &quot;6&quot;
ActiveSheet.Cells(myRow, (myCol + myRightVal + offSetCell)).Select
rtCol = ActiveCell.Column
ActiveSheet.Range(Cells(myRow, rtCol), Cells(myRow, rtCol + myDuration - 1)).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End Select

myRow = myRow + 1
Set myRng = ActiveSheet.Cells(myRow, myCol)

Loop

End Sub



I APPRECIATE ANY ASSISTANCE,
Dyana

 

[DaleWatson123321]

Dyana,

After reviewing your description here, I believe the Conditional Formatting method will work.

Question, though... It appears that you will be carrying these months on - i.e. after Dec will follow Jan of the next year ???

If this is the case, then I would expect (hope) you would simply be able to enter the number 13 in column A - for a start data of Jan of the next year, etc for Feb, and so on.

Then, all you would need to do, is copy the Conditional Formatting over for the additional months, and adjust for each months - the same as has been done in my example.

I hope this helps. Please advise as to how you make out.

The offer to email you the file still stands.

Regards, ...Dale Watson dwatson@bsi.gov.mb.ca

 

[dwilson01]

Please clarify how the months are tabulated, ie
Yr1 Yr2 Yr3
1 13 25
2 14 26
3 15 27
4 16 28
5 17 29
6 18 30
7 19 31
8 20 32
9 21 33
10 22 34
11 23 35
12 24 36
If this is correct, then myRightVal = Right(myRng.Value mod 12, 2) will give you the month you are looking for. The reason nothing happens for months 7, 8, 9, 10, 11,12 is because there are no cases for these values. If cases 1-6 are indead the same then you could use something like:

Select Case myRigthValue
Case 1 to 6
Code goes here
Case 7 to 12
Code goes here
Case Else
Code goes here

So, either I am way off or I can help a great deal. If this is helpful, I think I could solve your problem with a little sample data. You could send me a sample at dsw3687@hotmail.com if you would like me to look at this further.