Variable variables and sub routines

A

Also

(Excel 2000)
OK,Really wanted conditional formatting with 5 options but failing that have
created a Macro to do the colouring for me:

----------
Sub colourit()
'Colour it
If aai2004 >= aci2004 Then
abi2004.Select
With Selection.Interior
'Light orange
.ColorIndex = 3
.Pattern = xlSolid
End With
ElseIf Iaai2004 >= adi2004 Then
abi2004.Select
With Selection.Interior
'Light orange
.ColorIndex = 45
.Pattern = xlSolid
End With
ElseIf aai2004 >= aei2004 Then
abi2004.Select
With Selection.Interior
'Light orange
.ColorIndex = 6
.Pattern = xlSolid
End With
ElseIf aai2004 >= afi2004 Then
abi2004.Select
With Selection.Interior
'Light orange
.ColorIndex = 36
.Pattern = xlSolid
End With
Else: abi2004.Select
Selection.Interior.ColorIndex = xlNone
End If
End Sub
----------

However, I want to change the cell ranges each time so they are set using:
----------
Sub colset()
'Set ranges for colour up (round one)
Set aai2004 = Range("D5")
Set abi2004 = Range("D5,D27")
Set aci2004 = Range("D47")
Set adi2004 = Range("D48")
Set aei2004 = Range("D49")
Set afi2004 = Range("D50")
colourit
End Sub

----------
Of course it doesn't work as it can't read the variables...
And I can't set the globally as I want to set it the next time round as:
----------
Set aai2004 = Range("F5")
Set abi2004 = Range("F5,F27")
Set aci2004 = Range("F47")
Set adi2004 = Range("F48")
Set aei2004 = Range("F49")
Set afi2004 = Range("F50")
----------

I could do it if I understood loops to just increment two columns each time
(e.g. D to F) for 8 loops. But not sure how.
But as you can imagine, unless I try to tidy up the calls etc it's going to
become very large very quickly.
Any thoughts on how I could make this work?...
At the moment I am ending up coding in Word and using search and replace!

All help/comments/being called an idiot for long coding (and then a
suggestion how to change it) gratefully received.
 
B

Bob Phillips

I am not sure that I understand what you are trying to do, but maybe you can
do something with this

Sub RunTest()
Dim i As Long

For i = 4 To 10 Step 2 'change to 10 to the final column number
colourit Cells(5, i), Cells(27, i), Cells(47, i), Cells(48, i),
Cells(49, i), Cells(50, i)
Next i

End Sub
Sub colourit(aai, abi, aci, adi, aei, afi)
Dim CI As Long
Dim rng As Range
Select Case True
Case aai >= aci: CI = 3: Set rng = aci
Case aai >= adi: CI = 45: Set rng = adi
Case aai >= aei: CI = 6: Set rng = aei
Case aai >= afi: CI = 36: Set rng = afi
Case Else: CI = xlNone: Set rng = Nothing
End Select

With abi.Interior
.ColorIndex = CI
.Pattern = xlSolid
End With

If Not rng Is Nothing Then rng.Interior.ColorIndex = CI
End Sub


--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
D

Dude Ranch

dude -
You've almost got the thinking right
I will assume your data starts at D5 and goes to the Right until an empty
cell

Sub Update()
Range("D5").select
Do
Clr = 0
If Activecell.offset(0,0).value = Activecell.offset(42,0).value
Then 'should be row 47
Clr = 3 'Light orange
ElseIf Activecell.offset(0,0).value = Activecell.offset(43,0).value
Then 'should be row 48
Clr = 45 '??
ElseIf Activecell.offset(0,0).value = Activecell.offset(44,0).value
Then 'should be row 49
Clr = 6 '??
ElseIf Activecell.offset(0,0).value = Activecell.offset(45,0).value
Then 'should be row 49
Clr = 36 '??
End If 'No Else required
'Now Colour in the Range
With Activecell.Offset(0,0).Range("a1:a22")
.Interior.ColorIndex = Clr
.Interior.Pattern = xlSolid
End With

Activecell.Offset(0,1).select 'Move to the next cell right
Loop While Activecell.Offset(0,0)<>"" 'keep going until there is an
empty cell

End sub

I hope you understand ElseIF correctly
Enjoy

Aloha
Jeff
 
D

Dude Ranch

bob,
Great minds think alike me thinks

Bob Phillips said:
I am not sure that I understand what you are trying to do, but maybe you
can do something with this

Sub RunTest()
Dim i As Long

For i = 4 To 10 Step 2 'change to 10 to the final column number
colourit Cells(5, i), Cells(27, i), Cells(47, i), Cells(48, i),
Cells(49, i), Cells(50, i)
Next i

End Sub
Sub colourit(aai, abi, aci, adi, aei, afi)
Dim CI As Long
Dim rng As Range
Select Case True
Case aai >= aci: CI = 3: Set rng = aci
Case aai >= adi: CI = 45: Set rng = adi
Case aai >= aei: CI = 6: Set rng = aei
Case aai >= afi: CI = 36: Set rng = afi
Case Else: CI = xlNone: Set rng = Nothing
End Select

With abi.Interior
.ColorIndex = CI
.Pattern = xlSolid
End With

If Not rng Is Nothing Then rng.Interior.ColorIndex = CI
End Sub


--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my
addy)
 
J

Joel

Don't think I got it eaxactly right. but this should help

Sub colourit(target As Range, Compare)
'Colour it


With target.Interior

Select Case Compare
Case Is >= aci2004
'Light orange
.ColorIndex = 3
.Pattern = xlSolid
Case Is >= adi2004
'Light orange
.ColorIndex = 45
.Pattern = xlSolid
Case Is >= aei2004
'Light orange
.ColorIndex = 6
.Pattern = xlSolid
Case Is >= afi2004
'Light orange
.ColorIndex = 36
.Pattern = xlSolid
End Select
abi2004.Interior.ColorIndex = xlNone
End With
End Sub
Sub colset()
For ColCount = 4 To 6
'Set ranges for colour up (round one)
Compare = Cells(5, ColCount)
Call colourit(Range(Cells(5, ColCount), Cells(27, ColCount)), _
Compare)
Call colourit(Cells(47, ColCount), Compare)
Call colourit(Cells(48, ColCount), Compare)
Call colourit(Cells(49, ColCount), Compare)
Call colourit(Cells(50, ColCount), Compare)
Next ColCount
End Sub
 
A

Also

Ok, I managed to use your great reply to eventually code the following below.
Still a bit sloppy- self taught macros and this is the first time I've used
Step, Case and carry over of variables... but it works.
I've reposted it here, with the comments so that people reading this query
can get an idea of how I worked it out.
Basically it's check a value in one cell against a range in another- think
Conditional formatting pretty much!

Thanks again for everyones help and suggestions.


Sub omega()
'Basically this breaks the work down into three sections.
'This get's it to Note there are two sections which need to be dealt with.
'I set the variable k and then use this as an offset vertically
Dim k As Long
For k = 1 To 2 Step 1
alpha (k)
Next k
End Sub

Sub alpha(k)
'This gets it to work along the rows
Dim j As Long
For j = 4 To 20 Step 4 '21 is the final rows number
beta j, k
Next j
End Sub

Sub beta(j, k)
Dim i As Long
'this goes along the columns
For i = 4 To 18 Step 2 '18 is the final column number
'Note that this selects teh cells to edit, and the ones to compare against.
colourit Cells((j + k), i), Cells(21 + ((j - 4) / 4) + (k * 6), i),
Cells((40 + (k * 7)), i), Cells((41 + (k * 7)), i), Cells((42 + (k * 7)), i),
Cells((43 + (k * 7)), i)
Next i
End Sub

'This does the actual colouring
Sub colourit(aai, abi, aci, adi, aei, afi)
'This sets which bits are to be recoloured.
Dim CI As Long
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = aai
Set rng2 = abi
Select Case True
'This does the comparison bit
Case aai >= aci: CI = 3
Case aai >= adi: CI = 45
Case aai >= aei: CI = 44
Case aai >= afi: CI = 36
Case Else: CI = xlNone
End Select
With rng1.Interior
..ColorIndex = CI
..Pattern = xlSolid
End With
With rng2.Interior
..ColorIndex = CI
..Pattern = xlSolid
End With
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top