Macro that Auto Fills Down Based when text Entered on Matching Columns

[squeakums]

Here are the example details of what I need; all is on the same tab:

When someone types something in column E; I'd like this macro to activate and fill down that same answer if it matches the person number and application name. I will pay for this answer if I can. It's because these files are large and have over 200,000+ rows.

Thank you!

 

[mohadin]

I simulate you data in #1
G11 , T11 AR11
Person no, application.., Person decision
I've tested in here!! test ok
BTW What Office version you use?

 

[mohadin]

If you excel does not like the last line let us try

Sub test()
    Dim a As Variant
    Dim i As Long
    Dim txt As String
    a = Range("G11:G" & Cells(Rows.Count, 7).End(xlUp).Row).Resize(, 38)
    ReDim b(1 To UBound(a))
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
        txt = a(i, 1) & a(i, 14)
            If txt <> "" Then
                If Not .exists(txt) Then
                    .Add txt, a(i, 38)
                    b(i) = a(i, 38)
                    Else
                    b(i) = .Item(txt)
                End If
            End If
        Next
       Range("AR11").Resize(UBound(b)) = Application.Transpose(b)
    End With
End Sub

 

[mohadin]

And if you manged the modification
Here the two options for worsheet code
1_

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a, b As Variant
    Dim i As Long
    Dim txt As String
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("AR:AR")) Is Nothing Then Exit Sub
    If (Target) <> "" Then
        a = Range("G11:G" & Cells(Rows.Count, 7).End(xlUp).Row).Resize(, 38)
        ReDim b(1 To UBound(a))
        With CreateObject("scripting.dictionary")
            For i = 1 To UBound(a)
                txt = a(i, 1) & a(i, 14)
                If txt <> "" Then
                    If Not .exists(txt) Then
                        .Add txt, a(i, 38)
                        b(i) = a(i, 38)
                    Else
                        b(i) = .Item(txt)
                    End If
                End If
            Next
            Range("AR11").Resize(UBound(a)) = Application.Transpose(b)
        End With
    End If
End Sub

2_

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a As Variant
    Dim i As Long
    Dim txt As String
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("AR:AR")) Is Nothing Then Exit Sub
    If (Target) <> "" Then
        a = Range("G11:G" & Cells(Rows.Count, 7).End(xlUp).Row).Resize(, 38)
        With CreateObject("scripting.dictionary")
            For i = 1 To UBound(a)
                txt = a(i, 1) & a(i, 14)
                If txt <> "" Then
                    If Not .exists(txt) Then
                        .Add txt, a(i, 38)
                    Else
                        a(i, 38) = .Item(txt)
                    End If
                End If
            Next
            Range("AR11").Resize(UBound(a)) = Application.Index(a, 0, 38)
        End With
    End If
End Sub

 

[squeakums]

I simulate you data in #1
G11 , T11 AR11
Person no, application.., Person decision
I've tested in here!! test ok
BTW What Office version you use?

2013

 

[squeakums]

Dim a As Variant Dim i As Long Dim txt As String a = Range("G11:G" & Cells(Rows.Count, 7).End(xlUp).Row).Resize(, 38) ReDim b(1 To UBound(a)) With CreateObject("scripting.dictionary") For i = 1 To UBound(a) txt = a(i, 1) & a(i, 14) If txt <> "" Then If Not .exists(txt) Then .Add txt, a(i, 38) b(i) = a(i, 38) Else b(i) = .Item(txt) End If End If Next Range("AR11").Resize(UBound(b)) = Application.Transpose(b) End With End Sub

 

[squeakums]

I get an out of memory error now. Working on it. Thank you for all of your help!

 

[squeakums]

How would you write the code if you are only seeing if the fill down is based on 1 field verses 2 fields. Maybe that's causing an issue. There were some modifications to the file and column counts so the person # is on column H and the fill down if entered is on column # 40 (an). I tried to modify the code below taking out the 2nd scenario.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a, b As Variant
    Dim i As Long
    Dim txt As String
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("An:An")) Is Nothing Then Exit Sub
    If (Target) <> "" Then
        a = Range("H11:H").End(xlUp).Row).Resize(, 40)
        ReDim b(1 To UBound(a))
        With CreateObject("scripting.dictionary")
            For i = 1 To UBound(a)
                txt = a(i)
                If txt <> "" Then
                    If Not .exists(txt) Then
                        .Add txt, a(i, 40)
                        b(i) = a(i, 40)
                    Else
                        b(i) = .Item(txt)
                    End If
                End If
            Next
            Range("An11").Resize(UBound(a)) = Application.Transpose(b)
        End With
    End If
End Sub

 

[mohadin]

At the very beginning at least

txt=a(i,1)

And

 a = Range("H11:H").End(xlUp).Row).Resize(, 40)

Should be

 a = Range("H11:H" & Cells(Rows.Count, 8).End(xlUp).Row).Resize(, 40)

 

[mohadin]

And column AN in a array is 33 not 40
so

If Not .exists(txt) Then
                        .Add txt, a(i, 33)
                        b(i) = a(i, 33)
                    Else

 

[squeakums]

And column AN in a array is 33 not 40
so

If Not .exists(txt) Then
                        .Add txt, a(i, 33)
                        b(i) = a(i, 33)
                    Else

It's starting at column A, so wouldn't it be an array of 40? Or, does it count from the person # column?