Adding Numerical Value to Range of Cells Based on Value in Adjacent Range of Cells

[seattletimebandit]

Hello All,

I've been trying to find a way to search down a single column and based on the text value in a cell, enter a numerical value in the adjacent cell to the left. I want to be able to assign the numbers to allow me to sort the text columns in a particular order, by using the numbers in the adjacent column. I'm thinking a CASE SELECT scenario.

Select Case score
    Case "Benzene"
        result = "1"
    Case "Ethylbenzene"
        result = "2"
    Case "Toluene"
        result = "3"
    Case "m, p-Xylene"
        result = "4"
    Case "o-Xylene"
        result = "5"
    Case "Gasoline"
        result = "6"
    'etc.
End Select

Here are the tables before and after adding the sort number, and the table after sorting the data:

	Before Adding Sort Number		After Adding Sort Number			After Sorted
Sort_Order	List		Sort_Order	List		Sort_Order	List
	Benzene		1	Benzene		1	Benzene
	Ethylbenzene		3	Ethylbenzene		1	Benzene
	Gasoline		6	Gasoline		2	Toluene
	m, p-Xylene		4	m, p-Xylene		2	Toluene
	o-Xylene		5	o-Xylene		3	Ethylbenzene
	Toluene		2	Toluene		3	Ethylbenzene
	Gasoline Range Organics		7	Gasoline Range Organics		4	m, p-Xylene
	#2 Diesel		9	#2 Diesel		4	m, p-Xylene
	Diesel Range Organics		8	Diesel Range Organics		5	o-Xylene
	Lube Oil		10	Lube Oil		5	o-Xylene
	Benzene		1	Benzene		6	Gasoline
	Ethylbenzene		3	Ethylbenzene		6	Gasoline
	Gasoline		6	Gasoline		7	Gasoline Range Organics
	m, p-Xylene		4	m, p-Xylene		7	Gasoline Range Organics
	o-Xylene		5	o-Xylene		8	Diesel Range Organics
	Toluene		2	Toluene		8	Diesel Range Organics
	Gasoline Range Organics		7	Gasoline Range Organics		9	#2 Diesel
	#2 Diesel		9	#2 Diesel		9	#2 Diesel
	Diesel Range Organics		8	Diesel Range Organics		10	Lube Oil
	Lube Oil		10	Lube Oil		10	Lube Oil

<tbody>
</tbody>

Thanks for your help in advance!

stb

 

[mumps]

Assuming your Sort_Order is in column A, List is in column B and data starts in row 2, try the following macro. You can add the additional items to the Select Case loop.

Sub AddNumVal()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range, foundRng As Range
    Dim sAddr As String
    For Each rng In Range("B2:B" & LastRow)
        Set foundRng = Range("B:B").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundRng Is Nothing Then
            sAddr = foundRng.Address
            Do
                Select Case foundRng.Value
                    Case "Benzene"
                        foundRng.Offset(0, -1) = 1
                    Case "Ethylbenzene"
                        foundRng.Offset(0, -1) = 2
                    Case "Toluene"
                        foundRng.Offset(0, -1) = 3
                    Case "m, p-Xylene"
                        foundRng.Offset(0, -1) = 4
                    Case "o-Xylene"
                        foundRng.Offset(0, -1) = 5
                    Case "Gasoline"
                        foundRng.Offset(0, -1) = 6
                End Select
                Set foundRng = Range("B:B").FindNext(foundRng)
            Loop While foundRng.Address <> sAddr
            sAddr = ""
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

Or a simpler version of mumps code

Sub AddNumVal()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
    Dim rng As Range
    For Each rng In Range("B2:B" & LastRow)
      Select Case rng.Value
          Case "Benzene"
              rng.Offset(0, -1) = 1
          Case "Ethylbenzene"
              rng.Offset(0, -1) = 2
          Case "Toluene"
              rng.Offset(0, -1) = 3
          Case "m, p-Xylene"
              rng.Offset(0, -1) = 4
          Case "o-Xylene"
              rng.Offset(0, -1) = 5
          Case "Gasoline"
              rng.Offset(0, -1) = 6
      End Select
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[seattletimebandit]

Mumps and Fluff,

Excellent! Both work perfectly.

Thanks!

 

[mumps]

@Fluff: I don't know why I made it over-complicated. Thanks for the input.

 

[Fluff]

I don't know why I made it over-complicated.

We've all "been there, seen it, done it"