copy columns down automatically when row is added

Hi,

Column X and Y contain values which can be changed as they are pulling from data validation.

I have a macro set up which automatically adds new rows of information to this worksheet. Currently new rows are added with the range A:V

The formula and value in column W will automatically copy down when a new row is added. I would like to do the same with columns X  and Y. The value that is copied down (e.g the choice of values through data validation) is not important as it will be selected by the user once the new row is added.

Mike
datal-validation-added.xlsm
mikes6058Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Roy CoxGroup Finance ManagerCommented:
Hi Mike

In the workbook that I finished just add the formulas in the existing data and copy down the row, the Table features will then work as with Column W.

Take a look at this

https://support.office.com/en-ca/article/Overview-of-Excel-tables-7ab0bb7d-3a9e-4b56-a3c9-6c94334e492c

If you aren't ure then put the formulas in the first Row and attach

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mikes6058Author Commented:
Ah I've figured it out. I had to input a formula e.g. cell x = cell above.

This way the table will automatically copy the formula down.

Thanks
Mike
mikes6058Author Commented:
Just another quick one. If I want the macro to exclude sending rows where columns X and Y contain other words in addition to RESOLVED and INTERNAL QUERY e.g. column Y could contain VOID or UNDER REVIEW how would I do this?

It would also need to make sure that when these rows are excluded they do not populate a date in column Z.

Mike
HTML5 and CSS3 Fundamentals

Build a website from the ground up by first learning the fundamentals of HTML5 and CSS3, the two popular programming languages used to present content online. HTML deals with fonts, colors, graphics, and hyperlinks, while CSS describes how HTML elements are to be displayed.

Roy CoxGroup Finance ManagerCommented:
I need to look at that code. I haven't access to it at the moment
mikes6058Author Commented:
The code is in the sheet I attached above. I haven't changed anything to it since you last uploaded.
Roy CoxGroup Finance ManagerCommented:
Sorry Mike I didn't realise that you hadn't changed anything. I thought you were changing it yesterday. Test this (no OutLook  here). Replace the existing code with this

'Callback for customButton2 onAction
Sub SendUpdate(control As IRibbonControl)

    Dim original_wb As Workbook
    Dim new_wb As Workbook
    Dim row_count As Long, col_count As Long, I As Long, J As Long
    Dim attachname As String, emailaddress As String
    Dim findprevem
    Dim OutApp As Object, OutMail As Object

    Set original_wb = ActiveWorkbook    'Workbooks.Open("P:\Cindy Simmers\Query Log\Rob - Query Log Work\THS_Query_Log.xlsm") 'adjust file location

    row_count = original_wb.Sheets(1).UsedRange.Rows.Count
    col_count = original_wb.Sheets(1).UsedRange.Columns.Count

    For I = 2 To row_count Step 1

        attachname = "THS Invoice Queries - Weekly Update.xlsx"
        emailaddress = original_wb.Sheets(1).Cells(I, "W").Value    'email address from column T
        If emailaddress <> "" Then
            findprevem = Application.Match(emailaddress, original_wb.Sheets(1).Range(original_wb.Sheets(1).Cells(1, "W"), original_wb.Sheets(1).Cells(I - 1, "W")), 0)
            If IsError(findprevem) Then
                Set new_wb = Workbooks.Add

                original_wb.Sheets(1).Range("A1:W1").Copy Destination:=new_wb.Sheets(1).Range("A1")
                For J = I To row_count
                    If original_wb.Sheets(1).Cells(I, "W").Value = original_wb.Sheets(1).Cells(J, "W").Value And _
                       original_wb.Sheets(1).Cells(J, "X").Value <> "RESOLVED" And _
                       original_wb.Sheets(1).Cells(J, "Y").Value <> "INTERNAL QUERY" Or _
                       original_wb.Sheets(1).Cells(J, "X").Value <> "VOID" Or _
                       original_wb.Sheets(1).Cells(J, "X").Value <> "UNDEr REVIEW" Then
                        original_wb.Sheets(1).Range("Z" & J).Value = Format(Date, "short date")
                        original_wb.Sheets(1).Range("A" & J & ":W" & J).Copy _
                                Destination:=new_wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1)
                    End If
                Next J

                Application.DisplayAlerts = False
                new_wb.Sheets(1).UsedRange.EntireColumn.AutoFit
                new_wb.SaveAs Environ("temp") & "\" & attachname
                new_wb.Close SaveChanges:=False
                Set new_wb = Nothing
                Application.DisplayAlerts = True

                Set OutApp = CreateObject("Outlook.Application")
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = emailaddress
                    .CC = ""
                    .BCC = ""
                    .Subject = "THS Invoice Queries - Weekly Update"    'adjust subjectline!
                    .Body = "Dear Supplier," & vbCrLf & vbCrLf & "Attached are the terms/details we hold on file for your current trading terms and contact details with THS direct. Please can you confirm these details are correct by placing a 1 in cell Z3." & vbCrLf & "If there are any differences please overwrite the current terms in red font." & vbCrLf & "Once confirmed please return the complete spreadsheet to rob.marr@thstools.co.uk" & vbCrLf & vbCrLf & "These terms will be incorporated into our THS Supplier Buying Agreement (SBA) which will subsequently be sent to yourselves to sign and return." & vbCrLf & vbCrLf & "Rob"
                    .Attachments.Add (Environ("temp") & "\" & attachname)
                    .Send
                    '.Save
                End With

                Set OutMail = Nothing
                Set OutApp = Nothing

                Kill Environ("temp") & "\" & attachname
            End If
        End If
    Next

End Sub

Open in new window

mikes6058Author Commented:
I've copied the code and now its send all the rows no matter what value is in column X or Y.

Could this have something to do with the fact columns X and Y contain choice values (e.g picked from a drop down).

I've attached the most up to date copy and code.

Mike
Roy CoxGroup Finance ManagerCommented:
The choices shouldn't make a difference. Are you looking to email rows where X and Y are empty? If so there may be a better way of coding than this.
datal-validation-added.xlsm
mikes6058Author Commented:
also I've noticed that when all column X fields are populated with a value which should be excluded e.g RESOLVED an email is still being sent. The email sends a blank work book but with the column headings in the top row. In this instance no emails should be sent at all.

I hope this makes sense.

Mike
mikes6058Author Commented:
Hi Roy,

populated rows with columns X and Y will never be empty.

X will be either;

PENDING
RESOLVED
VOID
UNDER REVIEW

y will be either;

INTERNAL QUERY
EXTERNAL QUERY


Rules:

1. Emails should not be sent if columns x or Y contain the following values.

RESOLVED
VOID
UNDER REVIEW
INTERNAL QUERY

also see point mentioned in my previous message.

I hope this is clearer for you. Let me know if you need further clarification.

Mike
mikes6058Author Commented:
To add: a date should only be published in column Z to the rows that have been emailed.
Roy CoxGroup Finance ManagerCommented:
I'll take a look later
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.