Excel Cell Formatting using Excel and/or VBA 1

[dyana]

Hello,

I would like to know how to set up a macro that could automatically code code cells if a certain condition was met.

If I have downloaded some information into excel and say column "D" shows a two-digit code, with the second number indicating the month i.e. 22 would mean calendar year 2002, the 2th month or Feb. 2002. Say column "E" shows a lead-tme variable in days i.e. 45 days. The lead time variable would start beginning with the month indicating by the second number of the two-digit code. The months are shown beginning with January through December in column "F' through "Q".

My objective would be to look at each line of the database and: 1) split out the second number of the two-digit year month to derive the month number i.e. if a "2" then February; and 2) look at the lead-time number and understands the month that it would get shipped in beginning with the month indicated by the second number of the two-digit code i.e. "2" for February.

For example, If I downloaded Jan through Decemer monthly forecast, and the number in column "D3" is "22", I would have to start the process at the column which shows February 2002 - column "F3". I would want to color code that cell and through April because the 45-day lead time would start in February and go one and a half month through April. Unfortunately, the macro has to look at each row because the lead-time will be different for each product line. For example, the next row down, the lead-time may be 84 days, resulting in February through May needing to be color coded.

To attempt to start this I have created two columns in "AA" and "AB" that shows the second digit of the two-digit month code and the lead-time translated into the month that it would fall into. In my first example of "22" and "45 day" lead time, "AA3" would show "2" and "AB3" would show "2" because 45 days equals one-and-a-half months and starting with February that would fall into the month of April, the second or "2" months after February. I recorded a macro that integrates Excel formulas to do this process.

My challenge now is to write a macro that can look at columns "AA" and "AB" for a large row area and color code a range that starts at say "D3 through Q200" for January through December. Unfortuately, this range will also change each month.

I appreciate any assistance in attempting to understand this challenge and helping me with it.

Thanks,
Diana

 

[LSTAN]

Hi

You can try this,

Dim myRow As Integer, myCol As Integer
Dim myRng As Range
Sheets("sheet1&quot.Select
Range("a1&quot.Select
myRow = ActiveCell.Row
myCol = ActiveCell.Column
Set myRng = ActiveSheet.Cells(myRow, myCol)
Do While myRng.Value <> &quot;&quot;
If Right(myRng.Value, 1) = &quot;2&quot; And ActiveSheet.Cells(myRow, myCol + 1) = &quot;45&quot; Then
'
'
'place your formatting here
'
'
'
myRow = myRow + 1
Set myRng = ActiveSheet.Cells(myRow, myCol)
Loop

this code will loop through the selected column

Hope this helps

Rgrds
LSTAN

 

[LSTAN]

Hi dyana

The forth line of the code should be read as

Range(&quot;aa1&quot.Select

Sorry


LSTAN

 

[dyana]

Thank you LSTAN for you help.

I am so new to the VBA particulars required on this. Your input are great. I tried to understand them. In the original explanation I think that I did not articulate the full requirement correctly.

The data range that will be tested for color coding in roughly 12 intersections of rows and columns. Every time I run this process the data range will change. As an example, let's say that the current download occupies a range that is 14 columns wide and 10 rows long. The first column shows a two-digit code. The second column designates a lead time in days i.e. 45 days. The next 12 columns show January through December.

I need to
1) look at the second number of the two digit code to understand the month to start color coding i.e &quot;2&quot; would be for February which would be shown in the fourth column, say column &quot;D&quot;, then
2) translate the lead time days for each row in the second column into the month that it would fall into beginning with the month interpreted in (1) above i.e. 45 days would fall into April, because it's 45 days from February. This would cause the March and April cells to be color coded. [All inputs are considered to be the 1st of the month].

Final objective would be to have, in this example, the cells for this row to be colored light yellow for the columns representing February through April.
There would need to be some looping because the next row would have a different lead time day, for example it may be shading from February through June.

In addition, the coding would have to set to start the cells color coding based on the column associated with the month represented by the second number of the two digit code. This &quot;month code&quot; would change during each incremental month's dowload.

I would love any suggestions or recommendations for this project. I would not be able to do this without some expert assistance. Thank you to whomever takes an interest in this.

Dyana

 

[LSTAN]

Hi dyana

You can try this piece of code ( a bit too long ) but I think it might be what you are looking for a start.


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(&quot;sheet1&quot.Select
Sheets(&quot;sheet1&quot.Range(&quot;a1&quot.Select
myRow = ActiveCell.Row
myCol = ActiveCell.Column
offSetCell = 2
Set myRng = ActiveSheet.Cells(myRow, myCol)

Do While myRng <> &quot;&quot;

myLeadDate = ActiveSheet.Cells(myRow, myCol + 1)
myDuration = Format((myLeadDate / 30), &quot;###0&quot
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

Please note the following assumptions:
1) the date is in column A and lead time on column B
2) a 30 days basis was used for the calculation
3) the code only test until the month June and you repeat the code for formatting for the rest

Hope this helps.

Rgrds
LSTAN

 

[dyana]

LSTAN,

Thanks your code worked great.

I just have one concern. Since the lead time calculation /30 and is formatted as &quot;###0&quot; it rounds the results and in some cases does not color code the correct number of columns.

For example, lead time of 74 days would color code the two columns, because 74/30 = 2.47. It rounds to &quot;2&quot; resulting in two columns being shaded, instead of three columns. I tried coding it as &quot;###0.000#, but this did not work.

I appreciate any assistance as always.

Dyana

 

[LSTAN]

Hi dyana

Just change this sentence

myDuration = Format((myLeadDate / 30), &quot;###0&quot

to

myDuration = (myLeadDate \ 30) + 1

The &quot;\&quot; operator will only show the integer part of the division, that's why we need to add 1 to it.

Hope this helps.

rgrds
LSTAN

 

[dyana]

LSTAN,

I tried your suggestion and it worked.

I only have one small problem. When the lead time is exactly one month, or two months i.e. 30 or 60 days, the new

myDuration = (myLeadDate \ 30) + 1

code highlights an additional column. If the lead time is 60 days, it highlights three column.

Do you know of a way around this.

Thanks you have been a life saver.

Dyana

 

[LSTAN]

Hi dyana

Here is how,

'
'
'
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
'
'
'
Hope this helps.

rgrds
LSTAN

 

[dyana]

LSTAN,

I have try to modify the code for instances when the lead time is 0, resulting in a requirement for none of the cell in that particular row shaded.

The code I have is:

Do While myRng <> &quot;&quot;

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

It doesn't like this because of the final &quot;Loop&quot; in the code.

I have researched Looping and can not seem to find what needs to be fixed.

dyana

 

[LSTAN]

hi dyana

Are you trying to trap for 0 lead time using

If myLeadDate = 0 Then
myDuration = 0
Else


Actually the Mod operator will take care of 0 lead time because anything divide by 0 will yields a 0 remainder therefore the above code is unnecessary. Unless you have something else?

rgrds
LSTAN

 

[dyana]

Yes,

I am trying to trap for 0 lead time.

I tried the above code because the rounding should yield no cells being coded for lead times of 0 yet the code did not work.

Any additional ideas?

dyana

 

[dyana]

Hello LSTAN,

The above code works great!

I just have a question...I need to modify the code to handle November and December. The code you helped me with above starts to shade columns beginning with the column corresponding to the 2nd digit of &quot;myRng&quot;. Although November is four months away, I need to modify the code right now. When the value of myRng is &quot;11&quot; or &quot;31&quot; for November, the column to begin the shading would be &quot;11th&quot; column, and when &quot;12&quot; or &quot;32&quot; for December the &quot;12th&quot; column.

I tried to create the additional code myself, but it did not work. The code is having a problem with the Loop without a Do. Can you help?

Here's the Current 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(&quot;sheet1&quot.Select
Sheets(&quot;sheet1&quot.Range(&quot;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)

If myRng = 11 Then
myRightVal = &quot;11&quot;

If myRng.Value = 12 Then
myRightVal = &quot;12&quot;

If myRng.Value = 31 Then
myRightVal = &quot;11&quot;

If myRng.Value = 32 Then
myRightVal = &quot;12&quot;

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