Error with simple code at "Select Case ActiveCell.Offset(0, i).Value"

Question

Hi

I'm new to VBA and haven't coded for a few years but need to write some code that will allow me to ultimately conditionally format using a number of conditions.  I need to build this out more but to get started I have written some basic code for a one row range but am getting an error at this line "Select Case ActiveCell.Offset(0, i).Value" .  Apologies I know this is pretty basic but I'm just getting started and can't figure out if this is a syntax error or something more fundamental.

Could someone please help?

Thanks

---

Option Compare Text 'A=a, B=b, ... Z=z

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Integer

Dim MyPlan As Range

Dim Cell As Range

Set MyPlan = Range("F6:AQ6")

For i = -41 To -3

    For Each Cell In MyPlan

                Select Case ActiveCell.Offset(0, i).Value

                Case "Phase 1"

                    Cell.Interior.ColorIndex = 3

                Case "Phase 2"

                    Cell.Interior.ColorIndex = 4

                Case "Phase 3"

                    Cell.Interior.ColorIndex = 5

                Case Else

                        Cell.Interior.ColorIndex = 2

                End Select

    Next

    Next

End Sub

Answer 1

Am 23.08.2010 15:52, schrieb CMW_001:

Thanks Andreas, that partially works.

I am glad to hear this. :-)

I  get a type mismatch error if I just enter the ranges as follows:

   StartDate = Range("D2:D20")

   EndDate = Range("E2:E20")

This is logical, I explain it once briefly.

When you make an assignment of one cell to one variable, then the contents of the cell is written into this variable.

The variable Startdate has the type "Date", so if we say

  StartDate = Range("A1")

the value of cell A1 will be written into the variable and thus becomes a date.

If you specify more than one cell like

  StartDate = Range("A1:A2")

you get a RTE 13 because the range returns an array of values and startdate can hold only one value.

Apologies but I'm not familiar with the Intersect function.  Does this recognise when there is an intersection at row level or do I need a loop of some kind?

You are right, we need a loop through the dates.

Intersect is a very powerful tool, try around a little bit with this macro, make some selections in a sheet, with not-related areas too and look what the MsgBox shows.

Sub Example_Intersect()

  Dim R As Range, C As Range

  Dim Msg As String

  If Not TypeOf Selection Is Range Then

    MsgBox "You did not select a range"

  Else

    Set R = Intersect(Selection, Rows(10))

    Set C = Intersect(Selection, Columns("F"))

    If R Is Nothing Then

      Msg = Msg & "Your selection intersects not Row 10"

    Else

      Msg = Msg & "Your selection intersects Row 10 at " & R.Address(0, 0)

    End If

    Msg = Msg & vbCrLf

    If C Is Nothing Then

      Msg = Msg & "and not Column F"

    Else

      Msg = Msg & "and intersects Column F at " & C.Address(0, 0)

    End If

    MsgBox Msg

  End If

End Sub

I think after a few tries, you'll understand what Intersect can do.

Back to your original question, the loop is very easy to program, but the many different colors are quite expensive... well not really, but I'm just lazy. ;-)

But we can do it with a nice trick very easy by simply reads the color of a cell. :-)

I simply take the cell containing the start date, if you don't like this feature or if you want a different cell and if you need help, just ask again.

Andreas.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim R As Range, C As Range

  Dim FirstDate As Date, LastDate As Date

  Dim StartDate As Date, EndDate As Date

  Dim ClearLine As Boolean

  'If nothing of our interest is changed we're done

  Set Target = Intersect(Target, Range("F6:AQ20,D6:D20,E6:E20"))

  If Target Is Nothing Then Exit Sub

  'Don't flicker with the screen

  Application.ScreenUpdating = False

  'Walk trough the first column

  For Each R In Range("F6:F20")

    'Get the dates from this row

    FirstDate = R

    LastDate = Range("AQ" & R.Row)

    'Create the ganttline for each task

    ClearLine = True

    'Walk trough the dates

    For Each C In Range("D6:D20")

      'Get the start date from column D

      StartDate = C

      'Get the end date from column E same row as in Column D

      EndDate = C.Offset(0, 1)

      'Create the ganttline

      CreateGanttLine Range(R, Range("AQ" & R.Row)), _

          StartDate, EndDate, FirstDate, LastDate, C.Interior.ColorIndex, ClearLine

      'Overwrite the colored cells next time

      ClearLine = False

    Next

  Next

  'Show the result

  Application.ScreenUpdating = True

End Sub

Answer 2

Thanks Andreas, I'll have a go

Answer 3

Thanks Andreas, that partially works.  I think I need a way of cycling through the Start and End date also. 

In the example above the StartDate would be range "D6:D20", and EndDate "E6:E20".  I  get a type mismatch error if I just enter the ranges as follows:

  StartDate = Range("D2:D20")

  EndDate = Range("E2:E20")

===================

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim R As Range

  Dim FirstDate As Date, LastDate As Date

  Dim StartDate As Date, EndDate As Date

   'If nothing of our interest is changed we're done

  Set Target = Intersect(Target, Range("F4:AQ20,D2:D20,E2:E20"))

  If Target Is Nothing Then Exit Sub

   'Get the dates for the task

  StartDate = Range("D2:D20")

  EndDate = Range("E2:E20")

   'Don't flicker with the screen

  Application.ScreenUpdating = False

  'Walk trough the first column

  For Each R In Range("F6:F20")

    'Get the dates from this row

    FirstDate = R

    LastDate = Range("AQ" & R.Row)

    'Create the ganttline

    CreateGanttLine Range(R, Range("AQ" & R.Row)), _

      StartDate, EndDate, FirstDate, LastDate, 5, True

  Next

  'Show the result

  Application.ScreenUpdating = True

End Sub

=========================

Apologies but I'm not familiar with the Intersect function.  Does this recognise when there is an intersection at row level or do I need a loop of some kind?

Answer 4

Am 20.08.2010 11:18, schrieb CMW_001:

Apologies I know this is pretty basic but I'm just getting started

Each of us has even begun, no one was born with the knowledge. ;-)

I see what you are trying, but that's absolutely senseless. With that technic you would never reach the goal.

And it can be so easy, I make an attempt. .-)

It is not exactly clear how your sheet looks like, but I guess that in your cells F6 to AQ20 are dates?

For example if the date 01.01.2010 is in F6, then in AQ6 is the 07.02.2010 and in F7 is the 08.02.2010 and so on until in AQ20 is the 24.07.2010

And the startdate of your task is D6 and the enddate is in E6?

If this is correct, try the code below, copy the sub CreateGanttLine from your other tread and your work is done.

Andreas.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim R As Range

  Dim FirstDate As Date, LastDate As Date

  Dim StartDate As Date, EndDate As Date

   'If nothing of our interest is changed we're done

  Set Target = Intersect(Target, Range("F6:AQ20,D6,E6"))

  If Target Is Nothing Then Exit Sub

   'Get the dates for the task

  StartDate = Range("D6")

  EndDate = Range("E6")

   'Don't flicker with the screen

  Application.ScreenUpdating = False

  'Walk trough the first column

  For Each R In Range("F6:F20")

    'Get the dates from this row

    FirstDate = R

    LastDate = Range("AQ" & R.Row)

    'Create the ganttline

    CreateGanttLine Range(R, Range("AQ" & R.Row)), _

      StartDate, EndDate, FirstDate, LastDate, 5, True

  Next

  'Show the result

  Application.ScreenUpdating = True

End Sub