Auto Populate record from one sheet to another Closed

Question

Hello, 

I'm working on a commissions spreadsheet for my company and would appreciate some assistance with a question I have. There is a separate tab for each sales rep as well as the Sales Director. For every record I enter for a sales rep, the same record needs to appear on the Sales Director's sheet. Is there a way to have a record automatically copied to the Sales Director's sheet when it's entered on a sales rep's sheet? It would need to populate the next available row on his sheet throughout the month.  If someone could please provide some guidance on this, it would be greatly appreciated.  Thanks in advance.

vcoolio · Answer

Hello Newhgl1,

Without seeing a sample of your actual work book, I am doing a little guessing here.

Following is my code which I believe will do the task for you:-

Sub SalesData()

Application.ScreenUpdating = False

Dim ws As Worksheet
Dim lRow As Integer
Set ws = ActiveSheet

For Each cell In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            If cell.Value = "OK" Then
                lRow = Sheets("Sales Director").Range("B" & Rows.Count).End(xlUp).Row + 1
                Range(Range("B" & cell.Row), Cells(cell.Row, Columns.Count).End(xlToLeft)).Copy Sheets("Sales Director").Range("B" & lRow)
                Sheets("Sales Director").Range("A" & lRow).Value = ws.Name
            End If
        Next cell

Application.CutCopyMode = False
Application.ScreenUpdating = True
Sheets("Sales Director").Select

End Sub


and following is a link to my test work book based on your explanation:-

https://www.dropbox.com/s/wo859lw6upt9b9c/Newhgl1%28Multi%20sheets%20to%20Master%20with%20individual%20buttons%29.xlsm?dl=0

As you can see in the test work book, the code is assigned to a button in each work sheet. You will need a criteria to determine which data from each indiviual sheet is sent to the Sales Director sheet so I've simply used "OK" in Column A of each sheet. Click on the button in a selected sheet and the relevant row of data labelled with "OK" in Column A will be transferred to the Sales Director's sheet.

In the Sales Directors sheet, the source sheet name will appear in Column A.

I hope that this will at least set you in the right direction.

Cheerio,
vcoolio.

vcoolio · Answer

Hello Newhgl1,

The only concern I have in my initial review of the sample you sent is that the data will be duplicated in the Sales Director's sheet each time the button is clicked. Is there a way to prevent duplicates? Thanks again for taking the time to help me with this!

I was wondering about this but I was just waiting for your reply first.

There are a few ways of taking care of duplicates:-

1) Delete any transferred data from each individual sheet. This depends on whether or not you wish to keep all data in each individual sheet.

2) Simply remove the criteria "OK" once the transfer has taken place.

3) Refresh the Sales Director's sheet. This basically means that any data in this sheet will be cleared and replaced with both new and old data from the individual sheets.

4) Add a "sort and remove duplicates" line of code for the Sales Director's sheet. Sorting would probably have to be done on dates. This method could become cumbersome.

5) Replace the criteria "OK" with a new word, say "Transferred", once the data has been transferred. The code won't recognise the word "Transferred" and hence will ignore any rows of data labelled with "Transferred" in Column A in each individual sheet.

Items (1) and (2) above are the simplest methods. However, I have a feeling that you may prefer item (5) above. Just in case, following is a revised code allowing for this:-


Sub SalesData()

Application.ScreenUpdating = False

Dim ws As Worksheet
Dim lRow As Integer
Set ws = ActiveSheet

For Each cell In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            If cell.Value = "OK" Then
                lRow = Sheets("Sales Director").Range("B" & Rows.Count).End(xlUp).Row + 1
                Range(Range("B" & cell.Row), Cells(cell.Row, Columns.Count).End(xlToLeft)).Copy Sheets("Sales Director").Range("B" & lRow)
                Sheets("Sales Director").Range("A" & lRow).Value = ws.Name
            End If
        Next cell
        
ChangeCriteria

Application.CutCopyMode = False
Application.ScreenUpdating = True
Sheets("Sales Director").Select

End Sub

Sub ChangeCriteria()

Dim lRow As Long

lRow = Range("A" & Rows.Count).End(xlUp).Row

For Each cell In Range("A2:A" & lRow)
        If cell.Value = "OK" Then
        cell.Value = "Transferred"
        End If
    Next
    
Columns.AutoFit

End Sub

and following is the link to my updated test work book:-

https://www.dropbox.com/s/uscql1sh4p3rmvl/Newhgl1%28Multi%20sheets%20to%20Master%20with%20individual%20buttons%2C2%29.xlsm?dl=0

I hope that this helps.

Cheerio,
vcoolio.

Auto Populate record from one sheet to another

2 responses

Subscribe To Our Newsletter!