Solved: Select range by used rows and named range

[goodwin57]

The following should give a range of about 11 to the right of E2 and 24 down. In fact as seen below, it selects a range of 2 rows and roughly the correct number of columns. I've been playing with this for a while so any suggestions would be very much appreciated.

Kind Regards

Simon



Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim VRange as Range
Dim WidthDist as Long
Dim MyList as Long

WidthDist = Worksheets("Dashboard").Range("Dates").Columns.Count
MyList = (Worksheets("Dashboard").Range("Subjects").Rows.Count*2)

Set VRange = Range("$E$2",Range($E$2.Offset(WidthDist,MyList))

[mdmackillop]

Try
Set VRange = Range("$E$2",Range("$E$2").Offset(WidthDist,MyList)

But simpler is
Set VRange = Range("$E$2").Resize(WidthDist,MyList)

[goodwin57]

Thank you for your response.
I've changed it to the "resize" option. You're quite right, its easier to simpler. However, it still doesn't seem to be working, the macro I have running when something chthe cell value changes in that range is only only working for those top two lines still :S. Any further suggestions much appreciated.

Regards

Simon

[goodwin57]

Scrap that, it only runs on the first row now :S

[mdmackillop]

Should it not be
Set VRange = Range("$E$2").Resize(MyList,WidthDist)

[goodwin57]

Embarrassing that you spotted that before me, yes it should, I've changed it now - but my macro seems to not run at all now...Is there any reason the resize as opposed to offset would make a:


If Not Intersect (Target, VRange) Is Nothing Then

stop working? Thank you for your help

[mdmackillop]

Can you post the complete sub?

[goodwin57]

Its very much a work in (slow) progress, note also that this is now probably a refined cross-thread to http://www.vbaexpress.com/forum/showthread.php?t=20510
I had the routine below the label "MotivationWork" running earlier.
Many thanks for your assistance, it is much appreciated



Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim VRange As Range
Dim Scores As Range
Dim Grade As Integer
Dim WidthDist As Integer
Dim Targ As Integer
Dim MyList As Integer
Dim Kind As String
Dim FindTarget As Range
Dim FindGrade As Range
Dim MyCell As String
Dim iValue As Long
Dim iColor As Integer
Dim Mycolor As Integer
Dim MyOffset As String


MyCell = Target.Address
'If Target.Value = "" Then
'Target.Interior.ColorIndex = 36
'GoTo FinishLine
'ElseIf Target.Value <> "" Then
'set the changed cell to a variable (which will be kept)
'the following 5 lines check the change was in the area im interested in
WidthDist = Worksheets("Dashboard").Range("Dates").Columns.Count
MyList = (Worksheets("Dashboard").Range("Subjects").Rows.Count * 2)
'MyOffset = Range("$E$2").Offset(WidthDist, MyList).Address
Set Scores = Worksheets("Dashboard").Range("Points")
Set VRange = Range("$E$2").Resize(MyList, WidthDist).Activate


If Not Intersect(Target, VRange) Is Nothing Then


KindLabel: Range("$B" & Target.Row).Activate
If ActiveCell.Value = "Grade" Then
GoTo GradeWork
ElseIf ActiveCell.Value = "Motivation" Then
GoTo MotivationWork


GradeWork:
' Translate the Target to a number:
Set FindTarget = Worksheets("Dashboard").Range("Points").Find(What:=Range("D" & Target.Row), LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
'Range(FindTarget).Activate
Targ = ActiveCell.Offset(0, 1).Select.Value
' Translate the Grade to a number:
Compare:
Set FindGrade = Worksheets("Dashboard").Range("Points").Find(What:=Target, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
'Range(FindGrade).Activate
Grade = ActiveCell.Offset(0, 1).Select.Value

iValue = (Grade - Targ)
Select Case iValue
Case Is > 0
iColor = 3
Case Is = 0
iColor = 4
Case Is < 0
iColor = 8
End Select

Range(MyCell).Activate
Target.Interior.ColorIndex = iColor
Range(MyCell).Activate
End If
GoTo FinishLine


MotivationWork:
Select Case Target.Value
Case 1 To 4
Mycolor = 3
Case 5 To 6
Mycolor = 6
Case 7 To 9
Mycolor = 43
End Select
Range(MyCell).Activate
Target.Interior.ColorIndex = Mycolor
Range(MyCell).Activate
End If
FinishLine:
End Sub

[goodwin57]

Solved - I was couting the wrong thing on the 'dates' section. Problems still exist, but I'll continue to attempt to address those. Thank you for your help,

Simon

[mdmackillop]

Hi Simon,
For more efficient code, avoid Selecting or Activating cells
BTW, Use the VBA button (or tags) to format code on this site

Private Sub Worksheet_Change(ByVal Target As Range)
Dim VRange As Range
Dim Scores As Range
Dim Grade As Integer
Dim WidthDist As Integer
Dim Targ As Integer
Dim MyList As Integer
Dim Kind As String
Dim FindTarget As Range
Dim FindGrade As Range
Dim MyCell As String
Dim iValue As Long
Dim iColor As Integer
Dim Mycolor As Integer
Dim MyOffset As String

'If Target.Value = "" Then
'Target.Interior.ColorIndex = 36
'GoTo FinishLine
'ElseIf Target.Value <> "" Then
'set the changed cell to a variable (which will be kept)
'the following 5 lines check the change was in the area im interested in
WidthDist = Worksheets("Dashboard").Range("Dates").Columns.Count
MyList = (Worksheets("Dashboard").Range("Subjects").Rows.Count * 2)
'MyOffset = Range("$E$2").Offset(WidthDist, MyList).Address
Set Scores = Worksheets("Dashboard").Range("Points")
Set VRange = Range("$E$2").Resize(MyList, WidthDist)
If Not Intersect(Target, VRange) Is Nothing Then
KindLabel:

Select Case Range("$B" & Target.Row)
Case "Grade"
GoTo GradeWork
Case "Motivation"
GoTo MotivationWork
End Select
GradeWork:
' Translate the Target to a number:
Target = Worksheets("Dashboard").Range("Points").Find(What:=Range("D" & Target.Row), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(0, 1).Value
' Translate the Grade to a number:
Compare:
Grade = Worksheets("Dashboard").Range("Points").Find(What:=Target, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False).Offset(0, 1).Value
iValue = (Grade - Targ)

Select Case iValue
Case Is > 0
iColor = 3
Case Is = 0
iColor = 4
Case Is < 0
iColor = 8
End Select
Target.Interior.ColorIndex = iColor
End If
GoTo FinishLine
MotivationWork:
Select Case Target.Value
Case 1 To 4
Mycolor = 3
Case 5 To 6
Mycolor = 6
Case 7 To 9
Mycolor = 43
End Select
Target.Interior.ColorIndex = Mycolor
End If
FinishLine:
End Sub

[goodwin57]

Hi Mdmackillop, I really appreciate the advise on the code. I'm not at my windows laptop now but I'll certainly make use of your modifications when I get a chance. I seem to have got most of the project working now which I'm very happy about! Cheers,

Simon vbmenu_register("postmenu_150774", true); I really appreciate