VBA Combining Select Case with Private Sub for data management

[ThePangloss]

Hey guys, so I'm trying to fix a set of data column by column. So for example I have

[TABLE="width: 500"]
<tbody>[TR]
[TD]Pass[/TD]
[TD]Score[/TD]
[TD]Age[/TD]
[TD]Gender[/TD]
[/TR]
[TR]
[TD]No[/TD]
[TD]40[/TD]
[TD]21[/TD]
[TD]Male[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]92[/TD]
[TD]19[/TD]
[TD]Female[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]87[/TD]
[TD]45[/TD]
[TD]Male[/TD]
[/TR]
[TR]
[TD]No[/TD]
[TD]69[/TD]
[TD]60[/TD]
[TD]Female[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]72[/TD]
[TD]37[/TD]
[TD]Female[/TD]
[/TR]
</tbody>[/TABLE]

and I want

[TABLE="width: 500"]
<tbody>[TR]
[TD]Pass[/TD]
[TD]Score[/TD]
[TD]Age[/TD]
[TD]Gender[/TD]
[/TR]
[TR]
[TD]N[/TD]
[TD]40-49[/TD]
[TD]20-25[/TD]
[TD]M[/TD]
[/TR]
[TR]
[TD]Y[/TD]
[TD]90-100[/TD]
[TD]15-19[/TD]
[TD]F[/TD]
[/TR]
[TR]
[TD]Y[/TD]
[TD]80-89[/TD]
[TD]40-45[/TD]
[TD]M[/TD]
[/TR]
[TR]
[TD]N[/TD]
[TD]60-69[/TD]
[TD]60-65[/TD]
[TD]F[/TD]
[/TR]
[TR]
[TD]Y[/TD]
[TD]70-79[/TD]
[TD]36-39[/TD]
[TD]F[/TD]
[/TR]
</tbody>[/TABLE]

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

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!

 

[mumps]

Try:

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.

 

[CalcSux78]

Many ways to do it. If you don't need Case statements:

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

 

[ThePangloss]

Try:

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.

 

[mumps]

Here is the code broken down into four separate macros that you can call from your main macro:

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