A Range in an Array causing macro to fail

**Mister P** · 12-30-2011, 04:26 AM

I'm working on a project where I need to match up names in the same row but in 2 different columns. A have a macro written to work the way I want. I'm using names from Column D in an array and using the find function to match names in Column A. The successful find results is placed in Column B.

Presently, I'm adding the names from Column D into the array manually. I have tried adding these programmatically, but the macro fails.

Hoping someone will spot where I'm going wrong.

Sub MarkCellsInColumnA()
    Dim FirstAddress As String
    Dim lookfor As String
    Dim MyArr As Variant
    Dim Rng As Range
    Dim lrA As Long, LrD As Long
    Dim i As Long
    
    lrA = Cells(Rows.Count, "A").End(xlUp).Row
    LrD = Cells(Rows.Count, "D").End(xlUp).Row

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


'The line directly below (commented out) is the one I wish to use
'but it does not work...
'MyArr = Range("D1:D" & LrD).Value

'The line directly below provides the results I reguire.

    MyArr = Array("wally", "paul", "laura", "catherine", "pete", "ron", "bill", _
                "geo", "george", "tom")
    With Sheets("Sheet1").Range("A1:A" & lrA)
        Range("B1:B" & lrA).ClearContents

        For i = LBound(MyArr) To UBound(MyArr)
            
            Set Rng = .Find(What:=MyArr(i), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    Rng.Offset(0, 1).Value = "x"
                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next i
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Thanks
Mister P

**Alf** · 12-30-2011, 05:15 AM

If you only whish to match names perhaps a code like this will do?

Option Explicit

Sub MarkCellsInColumnA()
    
Dim i As Long
Dim lrA As Long
     
lrA = Cells(Rows.Count, "A").End(xlUp).Row
Range("B1:B" & lrA).ClearContents
        
  For i = 1 To lrA
  
  If Cells(i, 1) Like Cells(i, 4) Then
   Cells(i, 2) = "x"
  End If
  
  Next i
   
End Sub

Alf

**nilem** · 12-30-2011, 05:35 AM

MyArr - a two dimensional array, so you need to specify the row and column for each element of the array, ie MyArr(i, 1)
try this

Sub MarkCellsInColumnA()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim i As Long

With Application
    .ScreenUpdating = False: .EnableEvents = False
End With
MyArr = Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value
With Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    .Offset(, 1).ClearContents
    For i = 1 To UBound(MyArr)
        Set Rng = .Find(What:=MyArr(i, 1), LookAt:=xlPart)
        'Set Rng = .Find(What:=MyArr(i, 1), LookAt:=xlWhole)    ' maybe?
        If Not Rng Is Nothing Then
            FirstAddress = Rng.Address
            Do
                Rng.Next.Value = "x"
                Set Rng = .FindNext(Rng)
            Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
        End If
    Next i
End With
With Application
    .ScreenUpdating = True: .EnableEvents = True
End With
End Sub