find and replace multiple criteria, with different set of criteria for each column

[cwyn_]

Hello,
I have a worksheet containing data, with headers at the top of each column.

I would like to be able to write VBA code that will look up the header at the top of each column and then based on the value of the header, use a set of rules to find and replace the entries in the cells of that column. Some columns would have multiple-criteria find and replace rules (e.g. replace 0 with "no" and 1 with "yes) and other columns would have numerical criteria for replacing values (e.g. replace 32,000 with 32; or replace values less than 3 with "0-3").

I have found various VBA solutions for replacing everything in a sheet or a single column with one set of multiple criteria, but what I would like to do is more complex because of the different set of criteria for each column, and I'm not sure how to modify code to do this.

If it is necessary to have two or three sets of VBA code, each for a different type of substitution (i.e. one for mathematical calculations such as dividing the value by 1000; one for straightforward substitution from a list of matched inputs and outputs; and one for substitutions based on inequalities for collapsing numerical values into ranges), that is ok. But I don't want to have to run a separate set of VBA code for every single column - the data I have to reformat often has many, many columns.

I have attached a sample file with some dummy data that gets at what I would like to do, in case that helps.

Sample Data:
[TABLE="width: 500"]
<tbody>[TR]
[TD]income[/TD]
[TD]participant[/TD]
[TD]GPA[/TD]
[TD]risk[/TD]
[/TR]
[TR]
[TD]$32,000[/TD]
[TD]0[/TD]
[TD]2.1[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]$54,000[/TD]
[TD]1[/TD]
[TD]3.2[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]$19,000[/TD]
[TD]1[/TD]
[TD]2.7[/TD]
[TD]1[/TD]
[/TR]
</tbody>[/TABLE]

Sample replacement rules (where x refers to the value in the cell in the data column with that header):[TABLE="width: 750"]
<tbody>[TR]
[TD]income[/TD]
[TD][/TD]
[TD]participant[/TD]
[TD][/TD]
[TD]GPA[/TD]
[TD][/TD]
[TD]risk[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]x[/TD]
[TD]x/1000[/TD]
[TD]0[/TD]
[TD]no[/TD]
[TD]x<1.67[/TD]
[TD]D/F[/TD]
[TD]0[/TD]
[TD]low[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]1[/TD]
[TD]yes[/TD]
[TD]2.67>x>1.66[/TD]
[TD]C[/TD]
[TD]1[/TD]
[TD]medium[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]3.67>x>2.66[/TD]
[TD]B[/TD]
[TD]2[/TD]
[TD]high[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x>3.66[/TD]
[TD]A[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Please feel free to let me know if anything I have outlined here about the question is not clear, and I am happy to provide more detail!
Thanks in advance for reading my post, and for any help!

 

[ParamRay]

.
.

Place the following macro in your workbook and change the indicated line.

Sub ConvertData()

    Dim sht As Worksheet
    Dim cnt(1 To 4) As Long
    Dim rng(1 To 4) As Range
    Dim c As Long
    Dim r As Range
    
    Set sht = ThisWorkbook.Worksheets("Data")   'change as necessary
    
    With sht
        For c = 1 To 4
            cnt(c) = .Cells(.Rows.Count, c).End(xlUp).Row
            Set rng(c) = Range(.Cells(2, c), Cells(cnt(c), c))
        Next c
    End With
    
    For Each r In rng(1)
        r.Value = r.Value / 1000
    Next r
    
    For Each r In rng(2)
        Select Case r.Value
            Case Is = 0: r.Value = "no"
            Case Is = 1: r.Value = "yes"
        End Select
    Next r
    
    For Each r In rng(3)
        If r.Value < (5 / 3) Then
            r.Value = "D/F"
        ElseIf r.Value >= (5 / 3) And r.Value < (8 / 3) Then
            r.Value = "C"
        ElseIf r.Value >= (8 / 3) And r.Value < (11 / 3) Then
            r.Value = "B"
        ElseIf r.Value >= (11 / 3) Then
            r.Value = "A"
        End If
    Next r
            
    For Each r In rng(4)
        Select Case r.Value
            Case Is = 0: r.Value = "low"
            Case Is = 1: r.Value = "medium"
            Case Is = 2: r.Value = "high"
        End Select
    Next r

End Sub

 

[cwyn_]

gpeacock, thanks so much for your help - this is really helpful!!

When I run the macro, I keep getting the error message "Runtime error '9': Subscript out of range", and when I run the debugger, it highlights the line that begins with "Set sht". I can't figure out why, though, since I have entered the correct worksheet name in the VBA code.

I'm pretty new to VBA, and so I may be making a stupid mistake here, but I just can't figure it out. I was hoping that someone here might be able to give me ideas about what I might be doing wrong?

 

[cwyn_]

OK, just an update in case it helps someone else: Replacing ThisWorkbook with ActiveWorkbook fixed the problem.
I'm still figuring out how to use macros in excel, so this was a somewhat silly mistake, but I wasn't understanding the difference between these two commands before now, relative to where the macro was stored...

 

[ParamRay]

OK, just an update in case it helps someone else: Replacing ThisWorkbook with ActiveWorkbook fixed the problem.
I'm still figuring out how to use macros in excel, so this was a somewhat silly mistake, but I wasn't understanding the difference between these two commands before now, relative to where the macro was stored...

Glad you got it to work!