Copy row from Sheet1 to another worksheet based on reference cell on Sheet1

[AmandaBA041017]

Hello All

I've been searching the forums for a solution to my dilemma, but my knowledge of functions is basic to intermediate, and VBA non-existent. Apologies if a similar post has been made. Chances are I looked at it, but didn't understand.

I have a master list of quotes on Sheet1 (titled "2017Quotes"). Column A is the first initial of the sales rep, and columns B through Q contain quote data. Based on the initial in Column A, I would like to have the whole row copy to a worksheet with the same initial. This would allow each sales rep to have a list of their quotes, as well allow me to maintain a master list.

Ideally, when I update Sheet1, the linked sheet would update as well.

Example spreadsheet can be found on my google drive: https://drive.google.com/file/d/0B8Q4B-Emo2YUZ2haRWZPUlRPdEE/view?usp=sharing

Thank you in advance for sharing your expertise!

 

[My Aswer Is This]

You said:
Column A is the first initial of the sales rep

So if the sales Reps name is George Brown
You would have in column (A) "G" is that correct?
And you would want this row copied to a sheet named "G"

What happens if you have more then one sales Rep with the same initial?
We cannot have two sheets with the same name.

Sales Reps should always have unique identifying numbers

 

[AmandaBA041017]

Correct, first initial of the first name only, copied to a sheet with the same initial. Appreciate the thought. We are a small company and trying to assign my sales reps numbers would only confuse them. Should we run into a situation where we have two of the same initials, someone will just have to change their name.

 

[cerfani]

Hello All

I've been searching the forums for a solution to my dilemma, but my knowledge of functions is basic to intermediate, and VBA non-existent. Apologies if a similar post has been made. Chances are I looked at it, but didn't understand.

I have a master list of quotes on Sheet1 (titled "2017Quotes"). Column A is the first initial of the sales rep, and columns B through Q contain quote data. Based on the initial in Column A, I would like to have the whole row copy to a worksheet with the same initial. This would allow each sales rep to have a list of their quotes, as well allow me to maintain a master list.

Ideally, when I update Sheet1, the linked sheet would update as well.

Example spreadsheet can be found on my google drive: https://drive.google.com/file/d/0B8Q4B-Emo2YUZ2haRWZPUlRPdEE/view?usp=sharing

Thank you in advance for sharing your expertise!

Sub OrganizeTerritoryData()
    Dim rowTracker(), i, ub, j As Long
    Dim initialedSheets(), ws As Worksheet

    ub = Sheets.Count - 2
    ReDim rowTracker(ub)
    ReDim initialedSheets(ub)

    'keep track of where you paste for each initialed sheet... im loading an array of numbers we start at row 2 for each one ;)
    
    For i = 0 to ub
        rowTracker(i) = 2
    Next i

    'now i will load an array of references to each initialed sheet

    i = 0
    For Each ws in Sheets
        If Len(ws.Name) = 1 Then
            Set initialedSheets(i) = ws
            i = i + 1
        End If
    Next ws

    'now for each sheet initialed sheet i have two array, one keeping track of the row i paste on and one the reference to the sheet... i just use the same index
    'now you loop through each row on the summary tab and just copy paste to the associated sheet and incrment that sheets counter to the next row

    With Sheets("2017Quotes")
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            For j = 0 To ub
                If initialedSheets(j).Name = .Cells(i, 1).Value2 Then
                    .Cells(i, 1).EntireRow.Copy initialedSheets(j).Cells(rowTracker(j), 1)
                    rowTracker(j) = rowTracker(j) + 1
                    Goto BreakPasteLoop
                End If
            Next j
BreakPasteLoop:
        Next i
    End With
End Sub

try that... untested...

 

[AmandaBA041017]

cerfani, this is a beautiful piece of code... problem is, my skill set is not this advanced. If it's not something I can enter it into the function field, I'm not even sure what to do with it. I'm computer savvy and follow direction well if you want to take the time to provide further instruction (even if its telling to to find a youtube tutorial covering "____ ."). If not, I understand. Either way, I do appreciate your help.

 

[My Aswer Is This]

You said:
Ideally, when I update Sheet1, the linked sheet would update as well.
I assume you mean when you update your sheet named "2017Quotes"

If you want this to happen this way I suggest you try this

When you have all the data entered on your row then double click on column "A" where you have your initial entered and this row of data will now be copied to the proper sheet. And the cell you doubled clicked on will turn Green letting you know this row has been copied over.



This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab named "2017Quotes"
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Cancel = True
Dim r As Long
Dim ans As String
Dim Lastrow As Long
On Error GoTo M
r = Target.Row
ans = Target.Value
Lastrow = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(r).Copy Destination:=Sheets(ans).Rows(Lastrow)
Target.Interior.ColorIndex = 4
Exit Sub
M:
MsgBox "No such sheet named  " & ans & "  exist"
End If
End Sub

 

[cerfani]

cerfani, this is a beautiful piece of code... problem is, my skill set is not this advanced. If it's not something I can enter it into the function field, I'm not even sure what to do with it. I'm computer savvy and follow direction well if you want to take the time to provide further instruction (even if its telling to to find a youtube tutorial covering "____ ."). If not, I understand. Either way, I do appreciate your help.

oh ok... when you have Excel open... press Alt + F11 this will open the VBA Editor

In this screen you will see a side pane on the left that has a list of vba projects... each one associated to an open workbook

You will most likely see a workbook on that list called Personal.xls and it will be invisible. If you ever write code that you want available whenever you open excel, then you save code in that personal project. Excel is programmed to open this workbook and hide it so you can have macros that you wrote loaded and available for use.

If you have code that you only want available when you open a specific workbook then you just save your code to that project.

So now that you know that, this time just pick the project that is associated to your workbook with your data. You will see it's file name in the list. You will add my code to that project. Right click on that project and click on 'Insert' and insert a 'module'

Now a blank white sheet will appear on the main part of the window... copy paste my entire code to that white area... then just press the play button

 

[My Aswer Is This]

If you want to copy all rows over at one time use this script:

Sub Copy_Rows()
'Modified 5-19-17 3:05 PM EDT
Application.ScreenUpdating = False
Dim i As Long
Dim ans As String
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
On Error GoTo M
    For i = 1 To Lastrow
        
        
        If Cells(i, 1).Value <> "" Then
            ans = Cells(i, 1).Value
            Lastrowa = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1
            Rows(i).Copy Destination:=Sheets(ans).Rows(Lastrowa)
        End If
    Next
Application.ScreenUpdating = True
    
    Exit Sub
M:
MsgBox "No such sheet named  " & ans & "  exist"
Application.ScreenUpdating = True
End Sub