Multiple Arrays and Loops

[Peteor]

I am comparing 2 arrays, and based off the comparison, placing values from an array into a range using the active cell. I am not receiving errors, but two things are happening.

1. Excel (not my machine) locks up when I run the code - How can I improve my code so this does not happen

2. I believe the information is mismatching within my arrays. element 1 of myArray corresponds with element 1 of myArray2, the same for element 2, etc. How do I define bounds telling the computer to start with element 1 of each array?

Here is my code:

Sub Example()


Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


Dim myArray() As Variant
Dim myArray2() As Variant
Dim i As Long
Dim rng As Range
Dim element As Variant
Dim element2 As Variant


myArray = Range("B3:B128").Value
myArray2 = Range("C3:C128").Value




If ActiveSheet.Name = "Example Sheet 1" Then
Worksheets("Example Sheet 2").Activate
If ActiveSheet.Name = "Example Sheet 3" Then
Worksheets("Example Sheet 4").Activate
Else
End If
End If


Set rng = ActiveSheet.Range("M2:M5000")


For Each element In myArray
For Each element2 In myArray2
    
    For Each cell In rng
    
        If cell.Value = element Then
        cell.Activate
        cell.Offset(columnoffset:=2).Activate
        ActiveCell.Value = element2
        Else
        End If
        
    Next cell


Next element2
Next element


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub

 

[Fluff]

How about

Sub Example()
   Dim Ary As Variant
   Dim i As Long
   Dim Cl As Range
   
   Ary = Range("B3:V128").Value2
   If ActiveSheet.Name = "Example Sheet 1" Then
      Worksheets("Example Sheet 2").Activate
   ElseIf ActiveSheet.Name = "Example Sheet 3" Then
      Worksheets("Example Sheet 4").Activate
   End If

   With CreateObject("scripting.dictionary")
      For i = 1 To UBound(Ary)
         .item(Ary(i, 1)) = Ary(i, 2)
      Next i
      For Each Cl In Range("M2", Range("M" & Rows.Count).End(xlUp))
         Cl.Offset(, 2).Value = .item(Cl.Value)
      Next Cl
   End With
End Sub

 

[Peteor]

Once again, you are a wizard Fluff. That worked.

Same question, slight tweak.

I would like to
"Offset(columnoffset:=2).Activate"
and do it again using an
"rng2=ActiveSheet.Range("N2:N5000")"

 

[Fluff]

Make this change

      For Each Cl In Range("M2", Range("[COLOR=#ff0000]N[/COLOR]" & Rows.Count).End(xlUp))
         Cl.Offset(, 2).Value = .item(Cl.Value)
      Next Cl

 

[Peteor]

You rock! Thank you!

 

[Fluff]

You're welcome & thanks for the feedback

 

[Peteor]

Sorry Fluff... I just got to where I can test that (honestly I thought it was solid)... It does exactly what I want except... Imagine we are running these loops for columns O, P, & Q.

Column O - The first iteration of this test - Works like a charm.

Column P - I would like to skip over this column - It is writing the same information as column O to this column, essentially duplicating the information.

Column Q - The second iteration of this test - Works like a charm.

How do I implement the offset so column P is unaffected by the loops?

 

[Fluff]

Not sure I understand, The code I supplied doesn't write anything to col Q, just O & P

 

[Peteor]

I see. With my last response (without realizing it) I was trying to troubleshoot to make it work. You are correct about the code as you wrote it. Rather than writing to column P when using:

For Each Cl In Range("M2", Range("N" & Rows.Count).End(xlUp))
Cl.Offset(, 2).Value = .item(Cl.Value) Next Cl

How do I write to column Q?

 

[Fluff]

How about

Sub Peteor()
   Dim Ary As Variant
   Dim i As Long
   Dim Cl As Range
   
   Ary = Range("B3:C128").Value2
   If ActiveSheet.Name = "Example Sheet 1" Then
      Worksheets("Example Sheet 2").Activate
   ElseIf ActiveSheet.Name = "Example Sheet 3" Then
      Worksheets("Example Sheet 4").Activate
   End If

   With CreateObject("scripting.dictionary")
      For i = 1 To UBound(Ary)
         .Item(Ary(i, 1)) = Ary(i, 2)
      Next i
      For Each Cl In Range("M2", Range("M" & Rows.Count).End(xlUp))
         Cl.Offset(, 2).Value = .Item(Cl.Value)
         Cl.Offset(, 4).Value = .Item(Cl.Offset(, 1).Value)
      Next Cl
   End With
End Sub