[mso] Re: XL2K vb code needed
- From: "Colli, Anthony G" <Anthony.Colli@xxxxxxx>
- To: <mso@xxxxxxxxxxxxx>
- Date: Fri, 31 Jan 2003 09:30:15 -0500
April-
It took me a few days to find this code, I knew I had it but I could =
not find it. It kind of does what you need. It will loop through a =
selection and deepening on the value in the selected cell do some work. =
The work that this code does is it changes the background color of the =
cell based on the value. You can change this pretty easy.=20
The For Count =3D 1 To 415....Next (I had 415 rows) does the loop and =
the ActiveCell.Offset(1, 0).Activate moves the active cell.=20
-Anthony
--------------------------------------
Sub BGColor()
Dim rngActiveRange As Excel.Range
Set rngActiveRange =3D Selection
=20
For Count =3D 1 To 415
If ActiveCell.Value < 0 Then
With Selection.Interior
.ColorIndex =3D 31
.Pattern =3D xlSolid
.PatternColorIndex =3D xlAutomatic
End With
End If
=20
If ActiveCell.Value > 0 And ActiveCell.Value < 365 Then
With Selection.Interior
.ColorIndex =3D 28
.Pattern =3D xlSolid
.PatternColorIndex =3D xlAutomatic
End With
End If
=20
If ActiveCell.Value >=3D 365 And ActiveCell.Value <=3D 730 Then
With Selection.Interior
.ColorIndex =3D 33
.Pattern =3D xlSolid
.PatternColorIndex =3D xlAutomatic
End With
End If
=20
If ActiveCell.Value >=3D 731 And ActiveCell.Value <=3D 1095 Then
With Selection.Interior
.ColorIndex =3D 34
.Pattern =3D xlSolid
.PatternColorIndex =3D xlAutomatic
End With
End If
=20
If ActiveCell.Value >=3D 1096 And ActiveCell.Value <=3D 1460 Then
With Selection.Interior
.ColorIndex =3D 35
.Pattern =3D xlSolid
.PatternColorIndex =3D xlAutomatic
End With
End If
=20
If ActiveCell.Value >=3D 1461 And ActiveCell.Value <=3D 1825 Then
With Selection.Interior
.ColorIndex =3D 36
.Pattern =3D xlSolid
.PatternColorIndex =3D xlAutomatic
End With
End If
=20
If ActiveCell.Value >=3D 1826 And ActiveCell.Value <=3D 2190 Then
With Selection.Interior
.ColorIndex =3D 37
.Pattern =3D xlSolid
.PatternColorIndex =3D xlAutomatic
End With
End If
=20
If ActiveCell.Value >=3D 2191 And ActiveCell.Value <=3D 2555 Then
With Selection.Interior
.ColorIndex =3D 38
.Pattern =3D xlSolid
.PatternColorIndex =3D xlAutomatic
End With
End If
ActiveCell.Offset(1, 0).Activate
Next Count
=20
End Sub
------------------------------------------
-----Original Message-----
From: April Pace [mailto:4office@xxxxxxxxxxxxx]
Sent: Tuesday, January 28, 2003 11:59 PM
To: Office (E-mail)
Subject: [mso] XL2K vb code needed
My mind is blank to night.... trying to do to many things....
first what is the correct code for
dim my4thQtrRefund as string
my4thQtrRefund =3D range(aj5).value 'what ever the value in that cell =
(as
it goes down the 1000 rows) the the row number will keep changing
Can somebody give me a refresher on the do....loop... until
I need for the macro to go down a column (say approx 1000 rows) and if
my4thQtrRefund >=3D "15"
offset(0,-1).clearcontents 'offset one column to the left
else
do nothing
end if
Ok.... once the refund amount is greater then $15.00, then the company
issues a refund, once they have issued all the refunds for say this =
week,
then want the running total of the refund due (the column to the left of =
AJ
in this example) reset to zero or null
I KNOW, I KNOW this should be in Access.... Need to get a good =
workaround
until I convince them of that!!
*************************************************************
You are receiving this mail because you subscribed to mso@xxxxxxxxxxxxx =
or MicrosoftOffice@xxxxxxxxxxxxxxxx
To send mail to the group, simply address it to mso@xxxxxxxxxxxxx
To Unsubscribe from this group, send an email to=20
mso-request@xxxxxxxxxxxxx?Subject=3Dunsubscribe
Or, visit the group's homepage and use the dropdown menu. This will =
also allow you to change your email settings to digest or vacation (no =
mail).
//www.freelists.org/webpage/mso
To be able to use the files section for sharing files with the group, =
send a request to mso-moderators@xxxxxxxxxxxxx and you will be sent an =
invitation with instructions. Once you are a member of the files group, =
you can go here to upload/download files:
http://www.smartgroups.com/vault/msofiles
*************************************************************
*************************************************************
You are receiving this mail because you subscribed to mso@xxxxxxxxxxxxx or
MicrosoftOffice@xxxxxxxxxxxxxxxx
To send mail to the group, simply address it to mso@xxxxxxxxxxxxx
To Unsubscribe from this group, send an email to
mso-request@xxxxxxxxxxxxx?Subject=unsubscribe
Or, visit the group's homepage and use the dropdown menu. This will also allow
you to change your email settings to digest or vacation (no mail).
//www.freelists.org/webpage/mso
To be able to use the files section for sharing files with the group, send a
request to mso-moderators@xxxxxxxxxxxxx and you will be sent an invitation with
instructions. Once you are a member of the files group, you can go here to
upload/download files:
http://www.smartgroups.com/vault/msofiles
*************************************************************
Other related posts:
