VBA Multiple if statements with an Array

[decadence]

Hi, I am having a problem with multiple if statements, If a word is found in a cell from the array then if the offset cell equals a value then replace the offset cell with a new value, However depending on what has been found from the array needs to step through a different if statement to change the rotations, can someone help with this please. Also the words are not case sensitive.

Sub ChangeRotations()
'
    Dim x As range, Rng As range, Arr As Variant, i
    Set Rng = Selection
    Arr = Array("Apple123", "Banana143", "Carrot23-8", "Dairy-102mlc", "Eggs456")
    For i = LBound(Arr) To UBound(Arr)
        For Each x In Rng
            If Trim(x) <> "" Then
                If Trim(x) = Arr(i) Then '<--------- If Apple123 or Eggs456 is found from string within cell value
                    If x.Offset(, 2).Value = "0" Then x.Offset(, 2).Value = "90"
                    If x.Offset(, 2).Value = "90" Then x.Offset(, 2).Value = "180"
                    If x.Offset(, 2).Value = "180" Then x.Offset(, 2).Value = "270"
                    If x.Offset(, 2).Value = "270" Then x.Offset(, 2).Value = "0"
                End If

                If Trim(x) = Arr(i) Then '<--------- If Banana143 is found from string within cell value
                    If x.Offset(, 2).Value = "0" Then x.Offset(, 2).Value = "270"
                    If x.Offset(, 2).Value = "90" Then x.Offset(, 2).Value = "0"
                    If x.Offset(, 2).Value = "180" Then x.Offset(, 2).Value = "90"
                    If x.Offset(, 2).Value = "270" Then x.Offset(, 2).Value = "180"
                End If
                
                If Trim(x) = Arr(i) Then '<--------- If Carrot23-8 is found from string within cell value
                    If x.Offset(, 2).Value = "0" Then x.Offset(, 2).Value = "315"
                    If x.Offset(, 2).Value = "90" Then x.Offset(, 2).Value = "45"
                    If x.Offset(, 2).Value = "180" Then x.Offset(, 2).Value = "135"
                    If x.Offset(, 2).Value = "270" Then x.Offset(, 2).Value = "225"
                End If

                If Trim(x) = Arr(i) Then '<--------- If Dairy-102mlc is found from string within cell value
                    If x.Offset(, 2).Value = "0" Then x.Offset(, 2).Value = "45"
                    If x.Offset(, 2).Value = "90" Then x.Offset(, 2).Value = "135"
                    If x.Offset(, 2).Value = "180" Then x.Offset(, 2).Value = "225"
                    If x.Offset(, 2).Value = "270" Then x.Offset(, 2).Value = "315"
                End If
            End If
        Next x
    Next i
End Sub

 

[BarryL]

at the moment if an offset cell in your first vlock of IFs is 0 it will then change it to 90, then to 180, then to 270 and back to 0. I'm assuming this is incorrect. Can you try the below?

Sub ChangeRotations()
'
    Dim x As Range, Rng As Range, Arr As Variant, i
    Set Rng = Selection
        For Each x In Rng
        
                Select Case Trim(x)
                    Case Is = "Apple123", "Eggs456"
                        Select Case x.Offset(, 2).Value
                            Case Is = "0"
                            x.Offset(, 2).Value = "90"
                            Case Is = "90"
                            x.Offset(, 2).Value = "180"
                            Case Is = "180"
                            x.Offset(, 2).Value = "270"
                            Case Is = "270"
                            x.Offset(, 2).Value = "0"
                        End Select
                                               
                    Case Is = "Banana143"
                        Select Case x.Offset(, 2).Value
                            Case Is = "0"
                            x.Offset(, 2).Value = "270"
                            Case Is = "90"
                            x.Offset(, 2).Value = "0"
                            Case Is = "180"
                            x.Offset(, 2).Value = "90"
                            Case Is = "270"
                            x.Offset(, 2).Value = "180"
                        End Select
                        
            
                    Case Is = "Carrot23-8"
                        Select Case x.Offset(, 2).Value
                            Case Is = "0"
                            x.Offset(, 2).Value = "315"
                            Case Is = "90"
                            x.Offset(, 2).Value = "45"
                            Case Is = "180"
                            x.Offset(, 2).Value = "135"
                            Case Is = "270"
                            x.Offset(, 2).Value = "225"
                        End Select
                        
        
                    Case Is = "Dairy-102mlc"
                        Select Case x.Offset(, 2).Value
                            Case Is = "0"
                            x.Offset(, 2).Value = "45"
                            Case Is = "90"
                            x.Offset(, 2).Value = "135"
                            Case Is = "180"
                            x.Offset(, 2).Value = "225"
                            Case Is = "270"
                            x.Offset(, 2).Value = "315"
                        End Select
                       
                 End Select


        Next x
    
End Sub

 

[Eric W]

Another version:

Sub ChangeRotations2()
Dim x As Range, y As Object, MyDict As Object
    
    Set MyDict = CreateObject("Scripting.Dictionary")
    MyDict.Add "apple123", Array(90, 180, 270, 0)
    MyDict.Add "banana143", Array(270, 0, 90, 180)
    MyDict.Add "carrot23-8", Array(315, 45, 135, 225)
    MyDict.Add "dairy-102mlc", Array(45, 135, 225, 315)
    MyDict.Add "eggs456", Array(90, 180, 270, 0)
    
    On Error Resume Next
    For Each x In Selection
        Set y = x.Offset(, 2)
        y = MyDict(Trim(LCase(x)))(y / 90)
    Next x
End Sub

 

[decadence]

Hi BarryL and Eric W, Thank you they both work perfectly

 

[Eric W]

Glad we could help.