Change the value of each cell that meets criteria in a column - excel

Question

I am trying to change the value of each cell in column 7 that meets criteria. So far I managed to change the value with one criteria but I would like to add up to 14 criteria. Thanks for your help
Sub ChangeValue()
Dim i As Integer
Dim WK As Worksheet
Dim rg1 As range
Dim rg2 As range
Set WK = Sheet4
Set rg1 = range("AB2")
Set rg2 = range("AB3")
For i = Cells(Rows.Count, 7).End(xlUp).Row To 1 Step -1
If Cells(i, 7).Value = rg1 Then
Cells(i, 7).Value = rg2.Value
End If
Next i
End Sub
I would like to have more conditions something like if = AB3 change to AB4 if= AB4 Change to AB5 and so on...

Answer 1

To create a variable list of value/replace value pairs I would suggest using a dictionary:
Option Explicit
Sub ChangeValue()
Dim d
Set d = CreateObject("Scripting.Dictionary")
Dim r_test_value As Range
Dim r_anchor As Range
Set r_anchor = Range("AB2")
'need at least 2 values
If Not IsEmpty(r_anchor) And Not IsEmpty(r_anchor.Offset(1, 0)) Then
Set r_test_value = Range(r_anchor, _
Cells(Rows.Count, r_anchor.Column).End(xlUp).Offset(-1, 0))
Debug.Print r_test_value.Address
Dim i As Long
i = 0
Dim r As Range
For Each r In r_test_value
d.Add r.Value, r.Offset(i+1, 0).Value
i = i + 1
Next r
For i = Cells(Rows.Count, 7).End(xlUp).Row To 1 Step -1
If d.exists(Cells(i, 7).Value) Then
Cells(i, 7).Value = d.Item(Cells(i, 7).Value)
End If
Next i
End If
End Sub

Answer 2

Search and Replace Cell Values
EDIT
This is a more appropriate solution.
Adjust the starting rows i.e. For i = ? and For k = ?
Second Answer
Sub replaceValues()
' Determine Source Last Row.
Dim sLastRow As Long
sLastRow = Sheet4.Cells(Sheet4.Rows.Count, "AB").End(xlUp).Row
' Determine Destination Last Row.
Dim dLastRow As Long
dLastRow = Sheet4.Cells(Sheet4.Rows.Count, "G").End(xlUp).Row
Dim i As Long ' Destination Range Rows Counter
Dim k As Long ' Source Rows Counter
' Loop through rows of Destination Range.
For i = 2 To dLastRow
' Loop through rows of Source Range.
For k = 1 To sLastRow - 1
' When a value is found...
If Sheet4.Cells(i, "G").Value = Sheet4.Cells(k, "AB").Value Then
' ... replace it with the value below.
Sheet4.Cells(i, "G").Value = Sheet4.Cells(k + 1, "AB").Value
Exit For ' Value has been found and replaced. Stop searching.
' Otherwise you'll end up with the last replace value.
End If
Next k
Next i
' Inform.
MsgBox "Values replaced.", vbInformation, "Success"
End Sub
The First Answer (misunderstood)
The first solution is for using worksheet code names. It can be used for two worksheets. It is one in your case (Sheet4).
The second solution shows how to use it in two worksheets using worksheet names.
The code will loop through a column range of values and replace each value found in a row range of 'search values' with an associated 'replace value' in another same sized row range (in this case the ranges are adjacent, one below the other).
The Code
Option Explicit
Sub replaceValuesWorksheetCodeNames()
' Source
' Make sure the following two are of the same size.
Const srcAddress As String = "AB2:AO2"
Const rplAddress As String = "AB3:AO3"
' Destination
Const dFirstCell As String = "G2"
' Write Source Row Ranges to Source Arrays (Search and Replace).
With Sheet4
Dim srcData As Variant: srcData = .Range(srcAddress).Value
Dim rplData As Variant: rplData = .Range(rplAddress).Value
End With
' Define Destination Column Range.
Dim rg As Range
Dim RowOffset As Long
With Sheet4.Range(dFirstCell)
RowOffset = .Row - 1
Set rg = .Resize(.Worksheet.Rows.Count - RowOffset) _
.Find("*", , xlFormulas, , , xlPrevious)
If rg Is Nothing Then Exit Sub
Set rg = .Resize(rg.Row - RowOffset)
End With
' Write values from Destination Column Range to Data Array.
Dim rCount As Long: rCount = rg.Rows.Count
Dim Data As Variant
If rCount > 1 Then
Data = rg.Value
Else
ReDim Data(1 To 1, 1 To 1): Data = rg.Value
End If
' Search and replace values in Data Array.
Dim cValue As Variant
Dim cIndex As Variant
Dim i As Long
For i = 1 To rCount
cValue = Data(i, 1)
If Not IsError(cValue) Then
If Len(cValue) > 0 Then
cIndex = Application.Match(cValue, srcData, 0)
If IsNumeric(cIndex) Then
' When the replace data is in a row range.
Data(i, 1) = rplData(1, cIndex)
' When the replace data is in a column range.
'Data(i, 1) = rplData(cIndex, 1)
End If
End If
End If
Next i
' Write possibly modified values from Data Array back
' to Destination Column Range.
rg.Value = Data
' Inform.
MsgBox "Values replaced.", vbInformation, "Success"
End Sub
Sub replaceValuesWorksheetNames()
' Source
Const sName As String = "Sheet1"
' Make sure the following two are of the same size.
Const srcAddress As String = "AB2:AO2"
Const rplAddress As String = "AB3:AO3"
' Destination
Const dName As String = "Sheet2"
Const dFirstCell As String = "G2"
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook
' Write Source Row Ranges to Source Arrays (Search and Replace).
With wb.Worksheets(sName)
Dim srcData As Variant: srcData = .Range(srcAddress).Value
Dim rplData As Variant: rplData = .Range(rplAddress).Value
End With
' Define Destination Column Range.
Dim rg As Range
Dim RowOffset As Long
With wb.Worksheets(dName).Range(dFirstCell)
RowOffset = .Row - 1
Set rg = .Resize(.Worksheet.Rows.Count - RowOffset) _
.Find("*", , xlFormulas, , , xlPrevious)
If rg Is Nothing Then Exit Sub
Set rg = .Resize(rg.Row - RowOffset)
End With
' Write values from Destination Column Range to Data Array.
Dim rCount As Long: rCount = rg.Rows.Count
Dim Data As Variant
If rCount > 1 Then
Data = rg.Value
Else
ReDim Data(1 To 1, 1 To 1): Data = rg.Value
End If
' Search and replace values in Data Array.
Dim cValue As Variant
Dim cIndex As Variant
Dim i As Long
For i = 1 To rCount
cValue = Data(i, 1)
If Not IsError(cValue) Then
If Len(cValue) > 0 Then
cIndex = Application.Match(cValue, srcData, 0)
If IsNumeric(cIndex) Then
' When the replace data is in a row range.
Data(i, 1) = rplData(1, cIndex)
' When the replace data is in a column range.
'Data(i, 1) = rplData(cIndex, 1)
End If
End If
End If
Next i
' Write possibly modified values from Data Array back
' to Destination Column Range.
rg.Value = Data
' Inform.
MsgBox "Values replaced.", vbInformation, "Success"
End Sub