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]

Hi
Try this code!

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

 

[squeakums]

It seems to work and I appreciate your code Question is, how do you get it to work automatically as text is entered; like a private sub?

 

[squeakums]

I modified the code to match my real spreadsheet; for some reason it is deleting items that are lower like in rows 20 and lower; making those blank even though I am entering data. Perhaps I didn't change something in the code this time so it will flow with my new data.

For the two columns that need to match prior to fill down:
the person number is in column G; starting G11.
the application name is in column T; starting T11

where it needs to fill down is column AR; starting in AR11; count 38 over from column G

Did I update the code wrong below?

Sub Fill()
    Dim a, b As Variant
    Dim i As Long
    Dim txt As String
    a = Range("g11:g" & Cells(Rows.Count, 38).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]

Well,
a = Range("g11:g" & Cells(Rows.Count, 38).End(xlUp).Row).Resize(, 38)
What is in Column 38?
Any way debug Array a can you

 

[mohadin]

Just Try to change

a = Range("g11:g" & Cells(Rows.Count, 38).End(xlUp).Row).Resize(, 38)

To

a = Range("g11:g" & Cells(Rows.Count, 7).End(xlUp).Row).Resize(, 38)

Or any full column, you know what I mean

 

[mohadin]

Any way

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)
    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 Sub

New VERSION with your modi

 

[squeakums]

Well,
a = Range("g11:g" & Cells(Rows.Count, 38).End(xlUp).Row).Resize(, 38)
What is in Column 38?
Any way debug Array a can you

My real data has a lot more columns unfortunately.

 

[mohadin]

Any way, for resizing array (a) pick a column that goes to the end of your data not a short one

 

[squeakums]

Any way

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)
    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 Sub

New VERSION with your modi

I received a weird type mismatch error on this one once I changed it: