Simplify VBA-code

R

roelandwatteeuw

Board Regular
Joined
Feb 20, 2015
Messages
87
Office Version
  1. 365
Platform
  1. Windows
Hi all

I have this part in my code, it works, but I'm pretty sure it can be written in less lines.
And I can't figure out how exacly.

Who can help me with this?

Background info:
This macro shows an InputBox where the user has to choose one of the GemOptions.
The GemOptions are stored in sheet "Admin".
If only 10 GemOptioned are filled in in the sheet "Admin", the InputBox only shows this 10 options.
The user makes his choice by entering the corresponding number (1 to 29) of the GemOption (s)he likes.


VBA Code: 
Dim Gem1 As String
Dim Gem2 As String
Dim Gem3 As String
Dim Gem4 As String
Dim Gem5 As String
Dim Gem6 As String
Dim Gem7 As String
Dim Gem8 As String
Dim Gem9 As String
Dim Gem10 As String
Dim Gem11 As String
Dim Gem12 As String
Dim Gem13 As String
Dim Gem14 As String
Dim Gem15 As String
Dim Gem16 As String
Dim Gem17 As String
Dim Gem18 As String
Dim Gem19 As String
Dim Gem20 As String
Dim Gem21 As String
Dim Gem22 As String
Dim Gem23 As String
Dim Gem24 As String
Dim Gem25 As String
Dim Gem26 As String
Dim Gem27 As String
Dim Gem28 As String
Dim Gem29 As String

GemOption:
If Sheets("Admin").Range("B41") = "" Then Gem1 = "" Else Gem1 = "1 = " & Sheets("Admin").Range("B41") & vbCrLf
If Sheets("Admin").Range("B42") = "" Then Gem2 = "" Else Gem2 = "2 = " & Sheets("Admin").Range("B42") & vbCrLf
If Sheets("Admin").Range("B43") = "" Then Gem3 = "" Else Gem3 = "3 = " & Sheets("Admin").Range("B43") & vbCrLf
If Sheets("Admin").Range("B44") = "" Then Gem4 = "" Else Gem4 = "4 = " & Sheets("Admin").Range("B44") & vbCrLf
If Sheets("Admin").Range("B45") = "" Then Gem5 = "" Else Gem5 = "5 = " & Sheets("Admin").Range("B45") & vbCrLf
If Sheets("Admin").Range("B46") = "" Then Gem6 = "" Else Gem6 = "6 = " & Sheets("Admin").Range("B46") & vbCrLf
If Sheets("Admin").Range("B47") = "" Then Gem7 = "" Else Gem7 = "7 = " & Sheets("Admin").Range("B47") & vbCrLf
If Sheets("Admin").Range("B48") = "" Then Gem8 = "" Else Gem8 = "8 = " & Sheets("Admin").Range("B48") & vbCrLf
If Sheets("Admin").Range("B49") = "" Then Gem9 = "" Else Gem9 = "9 = " & Sheets("Admin").Range("B49") & vbCrLf
If Sheets("Admin").Range("B50") = "" Then Gem10 = "" Else Gem10 = "10 = " & Sheets("Admin").Range("B50") & vbCrLf
If Sheets("Admin").Range("B51") = "" Then Gem11 = "" Else Gem11 = "11 = " & Sheets("Admin").Range("B51") & vbCrLf
If Sheets("Admin").Range("B52") = "" Then Gem12 = "" Else Gem12 = "12 = " & Sheets("Admin").Range("B52") & vbCrLf
If Sheets("Admin").Range("B53") = "" Then Gem13 = "" Else Gem13 = "13 = " & Sheets("Admin").Range("B53") & vbCrLf
If Sheets("Admin").Range("B54") = "" Then Gem14 = "" Else Gem14 = "14 = " & Sheets("Admin").Range("B54") & vbCrLf
If Sheets("Admin").Range("B55") = "" Then Gem15 = "" Else Gem15 = "15 = " & Sheets("Admin").Range("B55") & vbCrLf
If Sheets("Admin").Range("B56") = "" Then Gem16 = "" Else Gem16 = "16 = " & Sheets("Admin").Range("B56") & vbCrLf
If Sheets("Admin").Range("B57") = "" Then Gem17 = "" Else Gem17 = "17 = " & Sheets("Admin").Range("B57") & vbCrLf
If Sheets("Admin").Range("B58") = "" Then Gem18 = "" Else Gem18 = "18 = " & Sheets("Admin").Range("B58") & vbCrLf
If Sheets("Admin").Range("B59") = "" Then Gem19 = "" Else Gem19 = "19 = " & Sheets("Admin").Range("B59") & vbCrLf
If Sheets("Admin").Range("B60") = "" Then Gem20 = "" Else Gem20 = "20 = " & Sheets("Admin").Range("B60") & vbCrLf
If Sheets("Admin").Range("B61") = "" Then Gem21 = "" Else Gem21 = "21 = " & Sheets("Admin").Range("B61") & vbCrLf
If Sheets("Admin").Range("B62") = "" Then Gem22 = "" Else Gem22 = "22 = " & Sheets("Admin").Range("B62") & vbCrLf
If Sheets("Admin").Range("B63") = "" Then Gem23 = "" Else Gem23 = "23 = " & Sheets("Admin").Range("B63") & vbCrLf
If Sheets("Admin").Range("B64") = "" Then Gem24 = "" Else Gem24 = "24 = " & Sheets("Admin").Range("B64") & vbCrLf
If Sheets("Admin").Range("B65") = "" Then Gem25 = "" Else Gem25 = "25 = " & Sheets("Admin").Range("B65") & vbCrLf
If Sheets("Admin").Range("B66") = "" Then Gem26 = "" Else Gem26 = "26 = " & Sheets("Admin").Range("B66") & vbCrLf
If Sheets("Admin").Range("B67") = "" Then Gem27 = "" Else Gem27 = "27 = " & Sheets("Admin").Range("B67") & vbCrLf
If Sheets("Admin").Range("B68") = "" Then Gem28 = "" Else Gem28 = "28 = " & Sheets("Admin").Range("B68") & vbCrLf
If Sheets("Admin").Range("B69") = "" Then Gem29 = "" Else Gem29 = "29 = " & Sheets("Admin").Range("B69") & vbCrLf


GemChoice = InputBox(Gem1 & Gem2 & Gem3 & Gem4 & Gem5 & Gem6 & Gem7 & Gem8 & Gem9 & Gem10 & Gem11 & Gem12 & Gem13 & Gem14 & Gem15 _
                    & Gem16 & Gem17 & Gem18 & Gem19 & Gem20 & Gem21 & Gem22 & Gem23 & Gem24 & Gem25 & Gem26 & Gem27 & Gem28 & Gem29, _
                    "Choose your Gem", GemChoice)
                If GemChoice = "" Then Exit Sub

        If GemChoice = "1" And Gem1 <> "" Then
            Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B41"))
        ElseIf GemChoice = "2" And Gem2 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B42"))
        ElseIf GemChoice = "3" And Gem3 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B43"))
        ElseIf GemChoice = "4" And Gem4 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B44"))
        ElseIf GemChoice = "5" And Gem5 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B45"))
        ElseIf GemChoice = "6" And Gem6 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B46"))
        ElseIf GemChoice = "7" And Gem7 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B47"))
        ElseIf GemChoice = "8" And Gem8 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B48"))
        ElseIf GemChoice = "9" And Gem9 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B49"))
        ElseIf GemChoice = "10" And Gem10 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B50"))
        ElseIf GemChoice = "11" And Gem11 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B51"))
        ElseIf GemChoice = "12" And Gem12 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B52"))
        ElseIf GemChoice = "13" And Gem13 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B53"))
        ElseIf GemChoice = "14" And Gem14 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B54"))
        ElseIf GemChoice = "15" And Gem15 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B55"))
        ElseIf GemChoice = "16" And Gem16 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B56"))
        ElseIf GemChoice = "17" And Gem17 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B57"))
        ElseIf GemChoice = "18" And Gem18 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B58"))
        ElseIf GemChoice = "19" And Gem19 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B59"))
        ElseIf GemChoice = "20" And Gem20 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B60"))
        ElseIf GemChoice = "21" And Gem21 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B61"))
        ElseIf GemChoice = "22" And Gem22 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B62"))
        ElseIf GemChoice = "23" And Gem23 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B63"))
        ElseIf GemChoice = "24" And Gem24 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B64"))
        ElseIf GemChoice = "25" And Gem25 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B65"))
        ElseIf GemChoice = "26" And Gem26 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B66"))
        ElseIf GemChoice = "27" And Gem27 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B67"))
        ElseIf GemChoice = "28" And Gem28 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B68"))
        ElseIf GemChoice = "29" And Gem29 <> "" Then Sheets("RBD").Range("L1").Value = UCase(Sheets("Admin").Range("B69"))
        Else
            MsgBox "Error" & vbCrLf _
                & "Incorrect value. Try again!", vbOKOnly, "Review Required!"
            GoTo GemOption
        End If
 
Sort by date Sort by votes

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
roelandwatteeuw said:
Thanks offthelip and dmt32 for the help


offthelip,
Your option looks quite good but misses the numbers I want in front of the Gems.

dmt32 - Dave,
Your option works perfect!
Hooray!


Thank you both for your time!
Click to expand...
Sorry I left out the numbers
If you want to try this small modification to my solution to add the numbers which will run much faster than dmt32 solution if that is an issue
VBA Code: 
Sub test()

' load all the gem choices
gemarray = Sheets("Admin").Range("B41:B69")

' concatenate them
allgems = ""
For i = 1 To 29
allgems = allgems & i & " = " & gemarray(i, 1) & vbCrLf
Next i
GemOption:
gemchoice = InputBox(allgems, "Choose your Gem", gemchoice)
If gemchoice = "" Then Exit Sub
If IsNumeric(gemchoice) Then
Sheets("RBD").Range("L1").Value = UCase(gemarray(gemchoice, 1))
Else
 MsgBox "Error" & vbCrLf _
                & "Incorrect value. Try again!", vbOKOnly, "Review Required!"
  GoTo GemOption
End If

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
How to make loop stop when the cell is empty? (VBA)
Replies
3
Views
291
kvsrinivasamurthy
K
C
  • Question Question
Combining rows 3 through 7 into row 2, one row takes a painfully long time with this code. Why?
Replies
2
Views
247
jolivanes
jolivanes
N
  • Question Question
VBA - Combining a Sub and a Function
Replies
1
Views
470
Micron
M
H
  • Question Question
Advanced Multi VBA - Creating multiple temporary files and attach them to one email on outlook
Replies
2
Views
264
Hayf13
H
X
  • Solved
Excel VBA Workbook code out of range when opened
Replies
5
Views
307
Xyphus
X

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

Share this page

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