VBA to autocomplete a row based on cell value and previous row data

[steve.waye]

Hi all,

I have a table with eight columns (A to H) that I use to log work activity.

Column A is the "Date", column B has some general information, column C is the "Client" and then the remaining columns contain information about the job for that particular client on that date (e.g. location of job, hours worked, fee charged, km traveled, etc.).

"Autocomplete" is switched on, so when the Client name is entered and has been used previously, the cell auto-fills so that I don't have to type the whole string.

All pretty standard stuff so far.

Now for the question.

The data for each client is usually the same, so I find myself entering the same info time and time again (even though autocomplete does make it a little easier).

I'm wondering if there is a way (I assume using VBA) to have the remainder of the cells on that row autocomplete based on the most recent row of data entered for that client?

I also need the option of changing the auto-fill data if necessary.

Any help would be much appreciated.

Thanks.

 

[offthelip]

You can put this code into the worksheet change subroutine for the sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 Then
 lastrow = Cells(Rows.Count, "C").End(xlUp).Row
 inarr = Range(Cells(1, 1), Cells(lastrow, 8))
 For i = lastrow - 1 To 1 Step -1
 If inarr(lastrow, 3) = inarr(i, 3) Then
   temp = Range(Cells(lastrow, 4), Cells(lastrow, 8))
    For j = 1 To 5
     temp(1, j) = inarr(i, 3 + j)
    Next j
    Application.EnableEvents = False
        Range(Cells(lastrow, 4), Cells(lastrow, 8)) = temp
    Application.EnableEvents = True
    
   Exit For
 End If
Next i
End If

End Sub

 

[My Aswer Is This]

Try this:
This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window
When you enter a value in column C the script will run
Not sure how many cells in the row you wanted copy so this script copies column D to M
If you want more then change 10 to what ever you want
see 10 in last row of code

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  12/8/2019  9:05 AM  EST
If Target.Column = 3 Then
    If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
    Dim Lastrow As Long
    Lastrow = Cells(Rows.Count, "C").End(xlUp).Row - 1
    Dim ans As String
    Dim r As Long
    Dim rr As Long
    Dim searchTerm As Range
    ans = Target.Value
    r = Target.Row
    Set searchTerm = Range("C1:C" & Lastrow).Find(what:=ans, searchorder:=xlByColumns, searchdirection:=xlPrevious)
    If searchTerm Is Nothing Then Exit Sub
    rr = searchTerm.Row
    Cells(rr, 4).Resize(, 10).Copy Cells(r, 4)

End If
End Sub

 

[My Aswer Is This]

Or try this. The script will adjust automatically how many cells to copy from the row.

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  12/8/2019  9:47:13 AM  EST
If Target.Column = 3 Then
On Error GoTo M
    If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
    Dim LastColumn As Long
    Dim Lastrow As Long
    Dim ans As String
    Dim r As Long
    Dim rr As Long
    Dim searchTerm As Range
    Lastrow = Cells(Rows.Count, "C").End(xlUp).Row - 1
    ans = Target.Value
    r = Target.Row
    Set searchTerm = Range("C1:C" & Lastrow).Find(what:=ans, searchorder:=xlByColumns, searchdirection:=xlPrevious)
    If searchTerm Is Nothing Then Exit Sub
    rr = searchTerm.Row
    LastColumn = Cells(rr, Columns.Count).End(xlToLeft).Column - 3
    Cells(rr, 4).Resize(, LastColumn).Copy Cells(r, 4)
End If
Exit Sub
M:
MsgBox "We had some sort of problem"
End Sub

 

[steve.waye]

Both solutions seem to work fine, so thank you to both of you.

I already had a Worksheet_Change event in that worksheet so I used the little trick below to allow the new code to be added, which worked a treat...

Running two codes - Private Sub Worksheet_Change(ByVal Target As Range)

Hello friends, hope all is well. the below code works smoothly, but I want to add another action. I want both codes to be placed in the same sheet module, and to take actions simultaneously please: thank you so much in advance! Private Sub Worksheet_Change(ByVal Target As Range) If...

www.mrexcel.com

Thanks again.

 

[My Aswer Is This]

Both solutions seem to work fine, so thank you to both of you.

I already had a Worksheet_Change event in that worksheet so I used the little trick below to allow the new code to be added, which worked a treat...

Running two codes - Private Sub Worksheet_Change(ByVal Target As Range)

Hello friends, hope all is well. the below code works smoothly, but I want to add another action. I want both codes to be placed in the same sheet module, and to take actions simultaneously please: thank you so much in advance! Private Sub Worksheet_Change(ByVal Target As Range) If...

www.mrexcel.com

Thanks again.

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.