VBA Combining Select Case with Private Sub for data management

ThePangloss

New Member
Joined
Jun 19, 2015
Messages
40
Hey guys, so I'm trying to fix a set of data column by column. So for example I have

PassScoreAgeGender
No4021Male
Yes9219Female
Yes8745Male
No6960Female
Yes7237Female

<tbody>
</tbody>

and I want

PassScoreAgeGender
N40-4920-25M
Y90-10015-19F
Y80-8940-45M
N60-6960-65F
Y70-7936-39F

<tbody>
</tbody>

pasted about 20 columns to the right of the original data

I wanted to create a macro that selects this whole range, checks if the first column's header is "Pass", and then calls a private sub that I've create using Select Case to fix "N" to "N" and "Yes" to "Y". Then it'll work to the next column. I just need to have it check the first column because I have various sheets of data all organized the same way. If it checks the first column and it does indeed say "Pass" it'll run the macro because the rest of the columns are all the same.

After it runs the first column it'll run the private sub for score to put it in buckets of tens let's say. So 40 would go into "40-50", 92 into "90-100". And so on for each column

I tried using

Code:
Dim List as Range
Dim counter As Integer
 
counter = 0
For with List in Range("A2:A5").Offset(0, counter)
List.Offset(0,20).Value

Call pass(Link As range)

End with

counter = counter + 1

counter = 0
For with List in Range("A2:A5").Offset(0, counter)
List.Offset(0,20).Value

Call score(List As range)

End with

End Sub

'Where the private sub is simply
 Private Sub pass()
Select Case List
Case "Yes"
.Value = "Y"
Case "No"
.Value = "N"
End Select

Private sub score()
Select Case List
Case 0 to 9
.Value = "0 to 9"
Case 10 to 19
.Value = "10 to 19"
'...repeated
End Select
but this means I have to manually retype the for with statement and have a long list of code. Is there any way to shorten this code using loops?

Any help would be appreciated!
 
Last edited:

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Try:
Code:
Sub ThePangloss()
    Application.ScreenUpdating = False
    Dim foundPass As Range
    Dim ColNum As Long
    Dim LastRow As Long
    Dim Pass As Range, Score As Range, Age As Range, Gender As Range
    Set foundPass = Rows(1).Find("Pass", LookIn:=xlValues, lookat:=xlWhole)
    ColNum = foundPass.Column
    LastRow = Cells(Rows.Count, ColNum).End(xlUp).Row
    For Each Pass In Range(Cells(2, ColNum), Cells(LastRow, ColNum))
        If Pass = "Yes" Then
            Pass = "Y"
        ElseIf Pass = "No" Then
            Pass = "N"
        End If
    Next Pass
    For Each Score In Range(Cells(2, ColNum + 1), Cells(LastRow, ColNum + 1))
        Select Case Score.Value
            Case 0 To 9
                Score = "0 to 9"
            Case 10 To 19
                Score = "10 to 19"
            Case 20 To 29
                Score = "20 to 29"
            Case 30 To 39
                Score = "30 to 39"
            Case 40 To 49
                Score = "40 to 49"
            Case 50 To 59
                Score = "50 to 59"
            Case 60 To 69
                Score = "60 to 69"
            Case 70 To 79
                Score = "70 to 79"
            Case 80 To 89
                Score = "80 to 89"
            Case 90 To 100
                Score = "90 to 100"
        End Select
    Next Score
    For Each Age In Range(Cells(2, ColNum + 2), Cells(LastRow, ColNum + 2))
        Select Case Age.Value
            Case 15 To 19
                Age = "15 to 19"
            Case 20 To 24
                Age = "20 to 24"
            Case 25 To 29
                Age = "25 to 29"
            Case 30 To 34
                Age = "30 to 34"
            Case 35 To 39
                Age = "35 to 39"
            Case 40 To 44
                Age = "40 To 44"
            Case 45 To 49
                Age = "45 To 49"
            Case 50 To 54
                Age = "50 To 54"
            Case 55 To 59
                Age = "55 To 59"
            Case 60 To 64
                Age = "60 To 64"
            Case 65 To 69
                Age = "65 To 69"
            Case 70 To 74
                Age = "70 To 74"
            Case 75 To 79
                Age = "75 To 79"
            Case 80 To 84
                Age = "80 To 84"
            Case 85 To 89
                Age = "85 To 89"
            Case 90 To 94
                Age = "90 To 94"
            Case 95 To 100
                Age = "95 To 100"
        End Select
    Next Age
    For Each Gender In Range(Cells(2, ColNum + 3), Cells(LastRow, ColNum + 3))
        If Gender = "Male" Then
            Gender = "M"
        ElseIf Gender = "Female" Then
            Gender = "F"
        End If
    Next Gender
    Application.ScreenUpdating = True
End Sub
Change the range values to suit your needs.
 
Last edited:
Upvote 0
Many ways to do it. If you don't need Case statements:
Code:
Sub DataManagement()
Dim R    As Long    'current row
Dim C    As Long    'current column
Dim lRow As Long    'last row
Dim i As Integer


lRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:D1").Copy Range("A1").Offset(, 20)
For R = 2 To lRow
    Cells(R, 1).Offset(, 20) = Left(Cells(R, 1), 1) 'Column A
    With WorksheetFunction
        'Column B
        i = .RoundDown(Cells(R, 2) / 10, 0)
        Cells(R, 2).Offset(, 20) = i * 10 & "-" & (i + 1) * 10 - 1
        'Column C
        i = .RoundDown(Cells(R, 3) / 5, 0)
        Cells(R, 3).Offset(, 20) = i * 5 & "-" & (i + 1) * 5 - 1
    End With
    Cells(R, 4).Offset(, 20) = Left(Cells(R, 4), 1) 'Column D
Next R
End Sub
 
Upvote 0
Try:
Code:
Sub ThePangloss()
    Application.ScreenUpdating = False
    Dim foundPass As Range
    Dim ColNum As Long
    Dim LastRow As Long
    Dim Pass As Range, Score As Range, Age As Range, Gender As Range
    Set foundPass = Rows(1).Find("Pass", LookIn:=xlValues, lookat:=xlWhole)
    ColNum = foundPass.Column
    LastRow = Cells(Rows.Count, ColNum).End(xlUp).Row
    For Each Pass In Range(Cells(2, ColNum), Cells(LastRow, ColNum))
        If Pass = "Yes" Then
            Pass = "Y"
        ElseIf Pass = "No" Then
            Pass = "N"
        End If
    Next Pass
    For Each Score In Range(Cells(2, ColNum + 1), Cells(LastRow, ColNum + 1))
        Select Case Score.Value
            Case 0 To 9
                Score = "0 to 9"
            Case 10 To 19
                Score = "10 to 19"
            Case 20 To 29
                Score = "20 to 29"
            Case 30 To 39
                Score = "30 to 39"
            Case 40 To 49
                Score = "40 to 49"
            Case 50 To 59
                Score = "50 to 59"
            Case 60 To 69
                Score = "60 to 69"
            Case 70 To 79
                Score = "70 to 79"
            Case 80 To 89
                Score = "80 to 89"
            Case 90 To 100
                Score = "90 to 100"
        End Select
    Next Score
    For Each Age In Range(Cells(2, ColNum + 2), Cells(LastRow, ColNum + 2))
        Select Case Age.Value
            Case 15 To 19
                Age = "15 to 19"
            Case 20 To 24
                Age = "20 to 24"
            Case 25 To 29
                Age = "25 to 29"
            Case 30 To 34
                Age = "30 to 34"
            Case 35 To 39
                Age = "35 to 39"
            Case 40 To 44
                Age = "40 To 44"
            Case 45 To 49
                Age = "45 To 49"
            Case 50 To 54
                Age = "50 To 54"
            Case 55 To 59
                Age = "55 To 59"
            Case 60 To 64
                Age = "60 To 64"
            Case 65 To 69
                Age = "65 To 69"
            Case 70 To 74
                Age = "70 To 74"
            Case 75 To 79
                Age = "75 To 79"
            Case 80 To 84
                Age = "80 To 84"
            Case 85 To 89
                Age = "85 To 89"
            Case 90 To 94
                Age = "90 To 94"
            Case 95 To 100
                Age = "95 To 100"
        End Select
    Next Age
    For Each Gender In Range(Cells(2, ColNum + 3), Cells(LastRow, ColNum + 3))
        If Gender = "Male" Then
            Gender = "M"
        ElseIf Gender = "Female" Then
            Gender = "F"
        End If
    Next Gender
    Application.ScreenUpdating = True
End Sub
Change the range values to suit your needs.


This looks great, thank you! However, is there a way to make private subs out of all the select case statements and call them in the main code? I have about 30 variables in my actual sheet so in terms of troubleshooting it would help if that was possible instead of having to look through a huge bunch of code that has 30 select case statements.
 
Last edited:
Upvote 0
Here is the code broken down into four separate macros that you can call from your main macro:
Code:
Sub Pass()
    Application.ScreenUpdating = False
    Dim foundPass As Range
    Dim ColNum As Long
    Dim LastRow As Long
    Dim Pass As Range
    Set foundPass = Rows(1).Find("Pass", LookIn:=xlValues, lookat:=xlWhole)
    ColNum = foundPass.Column
    LastRow = Cells(Rows.Count, ColNum).End(xlUp).Row
    For Each Pass In Range(Cells(2, ColNum), Cells(LastRow, ColNum))
        If Pass = "Yes" Then
            Pass = "Y"
        ElseIf Pass = "No" Then
            Pass = "N"
        End If
    Next Pass
    Application.ScreenUpdating = True
End Sub
Sub Score()
    Application.ScreenUpdating = False
    Dim foundPass As Range
    Dim ColNum As Long
    Dim LastRow As Long
    Dim Score As Range
    Set foundPass = Rows(1).Find("Pass", LookIn:=xlValues, lookat:=xlWhole)
    ColNum = foundPass.Column
    LastRow = Cells(Rows.Count, ColNum).End(xlUp).Row
    For Each Score In Range(Cells(2, ColNum + 1), Cells(LastRow, ColNum + 1))
        Select Case Score.Value
            Case 0 To 9
                Score = "0 to 9"
            Case 10 To 19
                Score = "10 to 19"
            Case 20 To 29
                Score = "20 to 29"
            Case 30 To 39
                Score = "30 to 39"
            Case 40 To 49
                Score = "40 to 49"
            Case 50 To 59
                Score = "50 to 59"
            Case 60 To 69
                Score = "60 to 69"
            Case 70 To 79
                Score = "70 to 79"
            Case 80 To 89
                Score = "80 to 89"
            Case 90 To 100
                Score = "90 to 100"
        End Select
    Next Score
    Application.ScreenUpdating = True
End Sub
Sub Age()
    Application.ScreenUpdating = False
    Dim foundPass As Range
    Dim ColNum As Long
    Dim LastRow As Long
    Dim Age As Range
    Set foundPass = Rows(1).Find("Pass", LookIn:=xlValues, lookat:=xlWhole)
    ColNum = foundPass.Column
    LastRow = Cells(Rows.Count, ColNum).End(xlUp).Row
    For Each Age In Range(Cells(2, ColNum + 2), Cells(LastRow, ColNum + 2))
        Select Case Age.Value
            Case 15 To 19
                Age = "15 to 19"
            Case 20 To 24
                Age = "20 to 24"
            Case 25 To 29
                Age = "25 to 29"
            Case 30 To 34
                Age = "30 to 34"
            Case 35 To 39
                Age = "35 to 39"
            Case 40 To 44
                Age = "40 To 44"
            Case 45 To 49
                Age = "45 To 49"
            Case 50 To 54
                Age = "50 To 54"
            Case 55 To 59
                Age = "55 To 59"
            Case 60 To 64
                Age = "60 To 64"
            Case 65 To 69
                Age = "65 To 69"
            Case 70 To 74
                Age = "70 To 74"
            Case 75 To 79
                Age = "75 To 79"
            Case 80 To 84
                Age = "80 To 84"
            Case 85 To 89
                Age = "85 To 89"
            Case 90 To 94
                Age = "90 To 94"
            Case 95 To 100
                Age = "95 To 100"
        End Select
    Next Age
    Application.ScreenUpdating = True
End Sub
Sub Gender()
    Application.ScreenUpdating = False
    Dim foundPass As Range
    Dim ColNum As Long
    Dim LastRow As Long
    Dim Gender As Range
    Set foundPass = Rows(1).Find("Pass", LookIn:=xlValues, lookat:=xlWhole)
    ColNum = foundPass.Column
    LastRow = Cells(Rows.Count, ColNum).End(xlUp).Row
    For Each Gender In Range(Cells(2, ColNum + 3), Cells(LastRow, ColNum + 3))
        If Gender = "Male" Then
            Gender = "M"
        ElseIf Gender = "Female" Then
            Gender = "F"
        End If
    Next Gender
    Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,726
Members
448,294
Latest member
jmjmjmjmjmjm

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