SEARCH

The How-To Geek Forums Have Migrated to Discourse

How-To Geek Forums / Microsoft Office

(Solved) - How can the shapes automatically detect numerical values in excel

(18 posts)
  • Started 2 years ago by amrinderminhas
  • Latest reply from amrinderminhas
  • Topic Viewed 1153 times

amrinderminhas
Posts: 59

Sir, one of my heads in the college wants a report to be prepared of the students marks in such a way that if the students score marks below a certain value (say 50%) in any of the subject then that value should be circled.
On the other hand if a student scored marks above a certain value (say 90%) then a star be marked in that cell.
Similarly other shapes could be used to denote the marks for say (60%-70% or 80%-90%) etc.
Now for a large excel sheet having large no. of students its not possible to do it manually.
Do in Excel by using any 'code' or else we can get such display...
I am attaching a picture in which column B has been filled by me manually. You can see there that the students getting marks less than 50% in subject 1 has been circled and students scoring above 90% have been starred on their respective cell.
Now I would like to display such data in whole of the columns......

Posted 2 years ago
Top
 
moreeg
moreeg
Posts: 842

Hi Amrinder

Excel has a built in ability to highlight cells based on their values. It won't give you what your professor is asking for in terms of stars and circles but it will colour the cells green and red (or whatever colours you want) to highlight high and low marks.

For this you would use Conditional Formatting. If you are interested in trying that let me know and I can walk you through it or you can wait for one of the others to come up with a solution that more closely resembles what you want.

Moree

Posted 2 years ago
Top
 
amrinderminhas
Posts: 59

@moreeg.. Yes I Know the method of conditional formating... But the problem by conditional formatting is we are using Black & White Printer ink only. So U can easily understand that if I am taking out the print with different colours, it will depict same grey colour in that printer. That is why i thought to give shapes rather than colours.
If u have other better idea than the shapes that can satisfy the need, it will be great help.
But i do want to know that isnt it possible actually to solve my problem in the way i asked before (by using shapes in excel)
Thanx for answering...

Posted 2 years ago
Top
 
moreeg
moreeg
Posts: 842

Hi Amrinder

Being constrained to black and white does present a challenge. You can still use conditional formatting to highlight - here is an example

While you wait for someone with more imagination than this you can try this out and play around with shading and patterns to get something that your professor will accept.

Posted 2 years ago
Top
 
amrinderminhas
Posts: 59

HI MOREEG
thanx buddy for the ideas but its not really solving the purpose, i ll wait for smone else to may be get me a better solution... but thanx for ur concern...

Posted 2 years ago
Top
 
Enthusiast
Enthusiast
Posts: 566

amrinderminhas, I am pretty sure there isn't an easy way to put your values inside a symbol in the same cell.

See if this will work for you.

1. Create a new column to the right of your grades.

2. Copy this (without the quotes) into the newly created cell:

"=IF(B2>89,CHAR(171),IF(B2>79,CHAR(162),IF(B2>69,CHAR(111),IF(B2>59,CHAR(108),CHAR(76)))))"

3. Fix the formula to fit your cell. For instance, if the cell your grade is in is not B2, change B2 in the formula to whatever cell your grade is in.

4. Copy this formula to the bottom of your data.

5. Click on the column name at the top of the new column (in this case, on the C), then Right-click and change the font to "wingdings".

If this will work for you, you can create columns after each of your grade columns and repeat the process. When that is done, I can show you how to make it look like the grades and the symbol are in the same cell.

Hope this helps.

Posted 2 years ago
Top
 
nosparks
Posts: 148

After lots of Google searching came across this at http://www.excelforum.com/exce.....stion.html
Definitely a starting point. Change SCALER to .4 and .line.weight to 1.5 and the circle looks not bad. I think we can address the OP's desires from here.

Sub PutCircleAround()
Const SCALER As Double = 1.2
Dim myCircle As Shape
Dim myWidth As Integer
Dim myLeft As Integer
Dim target As Excel.Range

Set target = ActiveCell
With target
If .Count > 1 Then Exit Sub
On Error Resume Next 'If already circled, Exit
Set myCircle = ActiveSheet.Shapes( _
"Circle_" & target.Address(0, 0))
If Not myCircle Is Nothing Then Exit Sub
On Error GoTo 0
'Put the left at 1/2 the Scaled width from cell center
'unless it would be to the left of the left sheet boundary
myLeft = Application.Max(1, .Left + .Width * (1 - SCALER) / 2)
'Set the width from myLeft to 1/2 Scaled width from cell ctr
myWidth = (.Left + .Width * (1 + SCALER) / 2) - myLeft
Set myCircle = ActiveSheet.Shapes.AddShape( _
msoShapeOval, myLeft, .Top, myWidth, .Height)
With myCircle
.Name = "Circle_" & target.Address(0, 0)
.Placement = xlMoveAndSize
.Fill.Transparency = 1
.Line.Weight = 3
.Line.ForeColor.SchemeColor = 10
End With
End With
End Sub

Posted 2 years ago
Top
 
nosparks
Posts: 148

Amrinder, I believe the code below will look after your circles and stars.

The code consists of 4 routines, one puts a circle on the current active cell, one puts a star on the current active cell, one cycles through your data, starting at cell B2 as it is in your screen shot, and decides on circle or star and another that can be used to remove all shapes from a worksheet. These routines have no worksheet designations, they operate on the currently active sheet.

These macro routines need to be in a module in your Excel workbook. Open Excel, hit ALT+F11 to open the VBA environment, from the menus Insert - Module, a new blank module will open, copy and paste the coding into the module and close the VBA environment. The macros are now ready to use. Hit ALT+F8 will bring up the Macro list and you can choose which one to run.

NoSparks

Sub PutCircleAround()
'found this with Google search leading to
'http://www.excelforum.com/excel-general/576668-circled-number-question.html
'altered perameters as require

Const SCALER As Double = 0.4
Dim myCircle As Shape
Dim myWidth As Integer
Dim myLeft As Integer
Dim target As Excel.Range

Set target = ActiveCell
With target
If .Count > 1 Then Exit Sub
On Error Resume Next 'If already circled, Exit
Set myCircle = ActiveSheet.Shapes( _
"Circle_" & target.Address(0, 0))
If Not myCircle Is Nothing Then Exit Sub
On Error GoTo 0
'Put the left at 1/2 the Scaled width from cell center
'unless it would be to the left of the left sheet boundary
myLeft = Application.Max(1, .Left + .Width * (1 - SCALER) / 2)
'Set the width from myLeft to 1/2 Scaled width from cell ctr
myWidth = (.Left + .Width * (1 + SCALER) / 2) - myLeft
Set myCircle = ActiveSheet.Shapes.AddShape( _
msoShapeOval, myLeft, .Top, myWidth, .Height)
With myCircle
.Name = "Circle_" & target.Address(0, 0)
.Placement = xlMoveAndSize
.Fill.Transparency = 1
.Line.Weight = 1.5
.Line.ForeColor.SchemeColor = 10
End With
End With
End Sub

Sub PutStarBeside()
'adaptation of PutCircleAround to use stars

Const SCALER As Double = 0.3
Dim myStar As Shape
Dim myWidth As Integer
Dim myLeft As Integer
Dim target As Excel.Range

Set target = ActiveCell
With target
If .Count > 1 Then Exit Sub
On Error Resume Next 'If already circled, Exit
Set myStar = ActiveSheet.Shapes( _
"Star_" & target.Address(0, 0))
If Not myStar Is Nothing Then Exit Sub
On Error GoTo 0
'Put the left at 1/2 the Scaled width from cell center
'unless it would be to the left of the left sheet boundary
myLeft = Application.Max(1, .Left + .Width * (1 - SCALER) / 2)
'Set the width from myLeft to 1/2 Scaled width from cell ctr
myWidth = (.Left + .Width * (1 + SCALER) / 2) - myLeft
Set myStar = ActiveSheet.Shapes.AddShape( _
msoShape5pointStar, myLeft + 15, .Top, myWidth, .Height) 'added 15 to be right of center
With myStar
.Name = "Star_" & target.Address(0, 0)
.Placement = xlMoveAndSize
.Fill.Transparency = 0
.Line.Weight = 1
.Line.ForeColor.SchemeColor = 0
End With
End With
End Sub

Sub HighliteMarks()

Dim AllMarks As Range
Dim mark As Range
Dim LastRow As Long
Dim LastCol As Long
Dim blanks As Long
Dim answer As Integer

'circle marks less than or equal to this
Const LowMark As Integer = 50
'star marks greater than or equal to this
Const HighMark As Integer = 90

'to speed things up
Application.ScreenUpdating = False

'establish the range of data to work on
'figure it backwards incase sheet has blanks
LastRow = Cells(65536, 2).End(xlUp).Row
LastCol = Cells(2, 256).End(xlToLeft).Column

Set AllMarks = Range(Cells(2, 2), Cells(LastRow, LastCol))

'warn of blank cells
blanks = Application.CountBlank(AllMarks)
If blanks > 0 Then
answer = MsgBox("The range to be operated on contains " & blanks & " empty cells", _
vbQuestion + vbOKCancel + vbDefaultButton2, "Blank Cells Found")
If answer = vbCancel Then Exit Sub
End If

'cycle through the data
For Each mark In AllMarks
mark.Select
If mark.Value <= LowMark And mark.Value <> "" Then PutCircleAround
If mark.Value >= HighMark Then PutStarBeside
Next mark

Range("A1").Select

Application.ScreenUpdating = True

End Sub

Sub RemoveShapes()
On Error Resume Next
ActiveSheet.DrawingObjects.Visible = True
ActiveSheet.DrawingObjects.Delete

End Sub

Posted 2 years ago
Top
 
moreeg
moreeg
Posts: 842

Hi Nosparks

Neat code. Thanks for spending the time to do that. I also gave it a try and came up with similar code (using the code you found as a base) except that I used a symbol instead of an object for the star. I must say though that it still seems to me that the value of having circles and stars does not (again, my opinion) justify the effort of building and maintaining the code. On the other hand, it was fun to work on. Anyways, here's the code I came up with ...

Sub PutCircleAround()
Const SCALER As Double = 0.7
Dim myCircle As Shape
Dim myWidth As Integer
Dim myLeft As Integer
Dim target As Excel.Range
Dim Sh As Shape

'Clears previous circles
With Worksheets("Sheet2")
For Each Sh In .Shapes
Sh.Delete
Next Sh
End With

'Key the beginning of the table from text = "roll nos."
FirstCell = Cells.Find("roll nos.").Offset(1, 1)
Cells.Find("roll nos.").Offset(1, 1).Select
FirstCellAddr = Cells.Find("roll nos.").Offset(1, 1).Address

'Set the boundaries of the table
FirstRow = Selection.Row
LastRow = Selection.End(xlDown).Row
FirstCol = Selection.Column
LastCol = Selection.End(xlToRight).Column

'Loop through twice - 1st for cols 2nd for rows
For r = 0 To LastRow - 3
For i = 0 To LastCol - 2

'Fined the cell to evaluate
Range(FirstCellAddr).Offset(r, i).Select
Set target = ActiveCell
With target

'Check if the cell is numeric (from a previous star) if not take the 1st 2 characters - gets rid of previous stars
If IsNumeric(target) = False Then
target = Left(target, 2)
End If

'Place a star if mark is 90 or over
If target > 89 Then
target = target & "¬"
With ActiveCell.Characters(Start:=3, Length:=1).Font
.Name = "Wingdings"
.FontStyle = "Regular"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
End If

If .Count > 1 Then Exit Sub

'if mark less 51
If target > 50 Then GoTo 111
CircleName = "Circle_" & i
On Error Resume Next
On Error GoTo 0
'Put the left at 1/2 the Scaled width from cell center
'unless it would be to the left of the left sheet boundary
myLeft = Application.Max(1, .Left + .Width * (1 - SCALER) / 2)
'Set the width from myLeft to 1/2 Scaled width from cell ctr
myWidth = (.Left + .Width * (1 + SCALER) / 2) - myLeft
Set myCircle = ActiveSheet.Shapes.AddShape( _
msoShapeOval, myLeft, .Top, myWidth, .Height)
With myCircle
.Name = "Circle_" & target.Address(r, i)
.Placement = xlMoveAndSize
.Fill.Transparency = 1
.Line.Weight = 1
.Line.ForeColor.SchemeColor = 10
End With
End With
111 Next i
222 Next r
End Sub

Posted 2 years ago
Top
 
nosparks
Posts: 148

@moreeg - thanks for looking and posting back. Like the old saying goes... there's more than one way to skin a cat.

The time to do that - it's called retirement and avoiding the "Honey Do" list.

Here's hoping the OP returns to give things a try. He seemed quite thrilled with the results for his previous Excel questions.

Posted 2 years ago
Top
 
Enthusiast
Enthusiast
Posts: 566

Nice work, you two :)

Posted 2 years ago
Top
 
amrinderminhas
Posts: 59

Hi, I m sorry a lill busy in my work. Still writing frim my iPhone, only to tell u dat I m keeping an eye on the solutions. But still doesn't got the time to try it. Surely ll try tomorrow and ll give u feedback. But in any of the case I must say reading above ur program's makes me think where am I standing?

Posted 2 years ago
Top
 
amrinderminhas
Posts: 59

Also can anybody guide me about the most efficient timetable kind of software that really has following advantages.;
1. Can handle lecture clashing of a faculty member in two separate classes at same time.
2. Can show not only one but more than one permutations and combinations of time table schedules. ( like if one set is not accepted then second can b looked upon..
3. Can add multiple constraints, ex: some lectures must be in the morning others always in evening by the constraint a user fix in that software.
4. And finally can it be done with Vba or something like that other programming here excellently..
Some of the student of sm prestigious college has made the prog.nd use it but he doesn't disclose to anybody...after all not everyone is as generous as u are here.
This is smthing I think the last big task I got, as I m the timetable Incharge of my mechanical Engg Deptt.

Posted 2 years ago
Top
 
Enthusiast
Enthusiast
Posts: 566

amrinderminhas,

Please take this latest request and create a new topic. That way we will be able to keep separate the responses to both projects. Also include information that would be helpful to answer your questions, ie. what form does the scheduling take? What is used for input, and what is the output.

Thanks.

Posted 2 years ago
Top
 
amrinderminhas
Posts: 59

Great job nosparks and company.... I Got the exact result what i wanted. Even i have changed the value of low marks and max marks and still got accurate result.

There is only one lill thing left here. Can u plz tell me if i just want the circles or stars to be run and not the both, then in nosparks program which all program structure written should be deleted....... It must be known to me so that i could customize according to the college needs...
Kindly explain this a little before i put "accept this answer"

Accepted Answer · Posted 2 years ago
Top
 
amrinderminhas
Posts: 59

I think I got the answer. If I could vary the minimum marks as (say 65%) and max is more than 100%( which can never be in marks or attendance) i think then i ll only be getting the circles and not any stars.....
Though its not the actual thing but still i think its easy to get what i want and still have the another formula...
Thanxx.... buddy here.... U guys really ROCK!!!!!!!!!

Posted 2 years ago
Top
 
nosparks
Posts: 148

Amrinder you don't really need to delete anything to only use circles or only use stars, just comment out the statement for the one you don't want to use. In the HighliteMarks routine put a single quote in front of the one you don't want to use.

Like this for circles only

'cycle through the data
For Each mark In AllMarks
mark.Select
If mark.Value <= LowMark And mark.Value <> "" Then PutCircleAround
'If mark.Value >= HighMark Then PutStarBeside
Next mark

and like this for stars only

'cycle through the data
For Each mark In AllMarks
mark.Select
'If mark.Value <= LowMark And mark.Value <> "" Then PutCircleAround
If mark.Value >= HighMark Then PutStarBeside
Next mark

NoSparks

Posted 2 years ago
Top
 
amrinderminhas
Posts: 59

@NoSparks.... I am so impressed with ur skills that i have advertised ur name in my college along with Enthusiast and moreeg.... U Guys are so fantastic dat what i hv dreamt to build a solid platform for my college is just started to become true coz of u guys.... I really salute u all here... May GOD bless u. I ll be obliged if one day i could help you in any way..... thanx
But surely i ll presenting u with more tough challenges in coming days.....lol....

Posted 2 years ago
Top
 



Topic Closed

This topic has been closed to new replies.

Enter Your Email Here to Get Access for Free:

Go check your email!