name cases

ndendrinos

Well-known Member
Joined
Jan 17, 2003
Messages
1,694
Can this be done?

I have 14 Case instead of multiple IF's
one by one 52 cells will be selected and will act on the 14 Case
Can I name the 14 Case as one and not have to end up with a mile long code?
Example:
Code:
Select Case Grade
        Case Is >= 90
            LetterGrade = "A"
        Case Is >= 80
            LetterGrade = "B"
        Case Is >= 70
            LetterGrade = "C"
        Case Is >= 60
            LetterGrade = "D"

       etc...etc...
        Case Else
            LetterGrade = "Sorry"
    End Select

would become:
Code:
Select Case test
    End Select
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
You could write it as a function

Code:
Function GradeToLetter(Grade As Single) As String
Select Case Grade
    Case Is >= 90
        GradeToLetter = "A"
    Case Is >= 80
        GradeToLetter = "B"
    Case Is >= 70
        GradeToLetter = "C"
    Case Is >= 60
        GradeToLetter = "D"
    Case Else
        GradeToLetter = "Sorry"
End Select
End Function

Then call it like this

Code:
Sub atest()
Dim x As Single, LetterGrade As String
x = 69
LetterGrade = GradeToLetter(x)
MsgBox LetterGrade
End Sub
 
Upvote 0
Thank you VoG realized that I should have used the real code instead of the one shown in my example.
Can you help out with this instead?
Note that the selection of "B1" and pasting to "C1" is one of 52 in the code
Many thanks

Code:
 Sub testinprogress()
Application.ScreenUpdating = False
'------------------------------------------------------------------------------------------
    
ActiveSheet.Shapes(Range("B1").Value).Copy
Range("C1").Select
ActiveSheet.Paste

Select Case Selection.Name
    
    Case Is = "Pictureas", "Pictureac", "Pictureah", "Picturead"
    Columns("J:J").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    ActiveCell.FormulaR1C1 = "11"
    
    Case Is = "Picture2s", "Picture2c", "Picture2h", "Picture2d"
    Columns("J:J").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    ActiveCell.FormulaR1C1 = "2"
    
    Case Is = "Picture3s", "Picture3c", "Picture3h", "Picture3d"
    Columns("J:J").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    ActiveCell.FormulaR1C1 = "3"
    
    Case Is = "Picture4s", "Picture4c", "Picture4h", "Picture4d"
    Columns("J:J").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    ActiveCell.FormulaR1C1 = "4"
            
    Case Is = "Picture8d"
    Columns("J:J").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    ActiveCell.FormulaR1C1 = "8"
    
    Case Is = "Picturejh"
    Columns("J:J").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    ActiveCell.FormulaR1C1 = "10"
    Case Else
    End Select
End sub
 
Upvote 0
Try

Code:
Sub testinprogress()
Dim i As Integer
Application.ScreenUpdating = False
'------------------------------------------------------------------------------------------
    
ActiveSheet.Shapes(Range("B1").Value).Copy
Range("C1").Select
ActiveSheet.Paste
i = NameToNumber(Selection.Name)
Columns("J").SpecialCells(xlCellTypeBlanks).Value = i
End Sub

Function NameToNumber(s As String) As Integer
Select Case s
    Case "Pictureas", "Pictureac", "Pictureah", "Picturead": NameToNumber = 11
    Case "Picture2s", "Picture2c", "Picture2h", "Picture2d": NameToNumber = 2
    Case "Picture3s", "Picture3c", "Picture3h", "Picture3d": NameToNumber = 3
    Case "Picture4s", "Picture4c", "Picture4h", "Picture4d": NameToNumber = 4
    Case "Picture8d": NameToNumber = 8
    Case "Picturejh": NameToNumber = 10
End Select
End Function
 
Upvote 0
Thank you VoG
This is very strange
Before I wrote the code I'm giving here I obtained code from mdmckillop that did not work the way I need it to work , and the strange part of it is that it acted the same way as your suggestion.
The goal is to use the function like this :
(let us say I have two buttons)

one button executes
ActiveSheet.Shapes(Range("B1").Value).Copy
Range("C1").Select
ActiveSheet.Paste

the other button executes
ActiveSheet.Shapes(Range("B2").Value).Copy
Range("D1").Select
ActiveSheet.Paste

the result I need in column J would be that just the first two rows would be filled.

My code does that but both codes provided by you and mdmackillop fills the J column from row 1 to row 101

There must be an explanation here but I don't see it

Many thanks
http://www.vbaexpress.com/forum/showthread.php?t=28197
 
Last edited:
Upvote 0
Then try

Code:
i = NameToNumber(Selection.Name)
Range("J1:J2").Value = i
 
Upvote 0
so the range is problematic
with this edit I get to fill Range("J1:J2")
Still not what's required for the first cick should fill just J1
then the second click (other button) should fill just J2

The range s/b first empty row in column J
like in my code:
Columns("J:J").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
ActiveCell.FormulaR1C1 = "11"
 
Last edited:
Upvote 0
Got it with many thanks VoG
Code:
 ActiveSheet.Shapes(Range("B1").Value).Copy
Range("C1").Select
ActiveSheet.Paste
i = NameToNumber(Selection.Name)
Columns("J:J").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
ActiveCell.Value = i

Was typing while you replied ... thanks again .. this one is solved
Regards, Nick
 
Upvote 0
Hmm. All this selecting should be avoided. Does this work?

Code:
ActiveSheet.Shapes(Range("B1").Value).Copy
Range("C1").Select
ActiveSheet.Paste
i = NameToNumber(Selection.Name)
Columns("J").SpecialCells(xlCellTypeBlanks)(1).Value = i
 
Upvote 0

Forum statistics

Threads
1,215,682
Messages
6,126,195
Members
449,298
Latest member
Jest

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top