Move to new sheet VBA

[traumaticcube]

Hi All,

First off I'm sorry if this has been posted before, I couldn't find anything specifically with this many values. I'm having some trouble wrapping my head around moving data from a master sheet to 26 other sheets based on the first letter of the last name. I successfully got it to work for just the "A's" but I can't figure out how to do it for the rest B through Z.

Basically, this is the sheet:

#	Last Name	First Name	Address	City	State	Zip	Phone	Sort Value
1	Apple	Jim	123	Main St	CA	10000	123-456-7890	A
2	Doe	Jane	123	Main St	NY	10000	8964	D

I want to be able to move the rows based on "Sort Value" which is column "I," to a new sheet. I have 27 sheets on the book, Main and then A through Z. I was able to get some VBA code I found on here to work and move the A's over but I can't figure out an efficient way to get it to move the 25 other letters over to their respective sheets. I'd also like it to move automatically.

Thanks for any help.

 

[Joe4]

Welcome to the Board!

Can you post the VBA code that you do have, and maybe we can help you amend it?

 

[traumaticcube]

I ended up changing it because I couldn't reverse engineer the other VBA so this is what I am using and it does work but not automatically:

'VBA Code by Scott from SpreadsheetPlanet.com
Sub move_rows_to_another_sheet()
    For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "A" Then
            myCell.EntireRow.Copy Worksheets("A").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
        For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "B" Then
            myCell.EntireRow.Copy Worksheets("B").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
        For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "C" Then
            myCell.EntireRow.Copy Worksheets("C").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
        For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "D" Then
            myCell.EntireRow.Copy Worksheets("D").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
            For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "E" Then
            myCell.EntireRow.Copy Worksheets("E").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
            For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "F" Then
            myCell.EntireRow.Copy Worksheets("F").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
            For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "G" Then
            myCell.EntireRow.Copy Worksheets("G").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
            For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "H" Then
            myCell.EntireRow.Copy Worksheets("H").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
            For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "I" Then
            myCell.EntireRow.Copy Worksheets("I").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
            For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "J" Then
            myCell.EntireRow.Copy Worksheets("J").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "K" Then
            myCell.EntireRow.Copy Worksheets("K").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "L" Then
            myCell.EntireRow.Copy Worksheets("L").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "M" Then
            myCell.EntireRow.Copy Worksheets("M").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "N" Then
            myCell.EntireRow.Copy Worksheets("N").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "O" Then
            myCell.EntireRow.Copy Worksheets("O").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "P" Then
            myCell.EntireRow.Copy Worksheets("P").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "Q" Then
            myCell.EntireRow.Copy Worksheets("Q").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "R" Then
            myCell.EntireRow.Copy Worksheets("R").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "S" Then
            myCell.EntireRow.Copy Worksheets("S").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "T" Then
            myCell.EntireRow.Copy Worksheets("T").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "U" Then
            myCell.EntireRow.Copy Worksheets("U").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "V" Then
            myCell.EntireRow.Copy Worksheets("V").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "W" Then
            myCell.EntireRow.Copy Worksheets("W").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "X" Then
            myCell.EntireRow.Copy Worksheets("X").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "Y" Then
            myCell.EntireRow.Copy Worksheets("Y").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
                For Each myCell In Selection.Columns(10).Cells
        If myCell.Value = "Z" Then
            myCell.EntireRow.Copy Worksheets("Z").Range("A" & Rows.Count).End(3)(2)
        End If
    Next
End Sub

 

[Joe4]

A few questions:

1. You said the sort column was column "I", but in your code, you are using the 10th column, which would be "J". Which is correct?
2. Is there any data on sheets A-Z at beginning before the code is run? Or are they all blank (except for headers) to start?
3. Is this only going to be run once? Or, will the data on the Main sheet be overwritten with new data at some point, and then the code will need to be run again?

 

[traumaticcube]

1. You said the sort column was column "I", but in your code, you are using the 10th column, which would be "J". Which is correct?
I added an extra column so sorry for that!

2. Is there any data on sheets A-Z at beginning before the code is run? Or are they all blank (except for headers) to start?
As of right now yes they are mainly blank. I don't want it to produce duplicates or overwrite the sheets if possible.

3. Is this only going to be run once? Or, will the data on the Main sheet be overwritten with new data at some point, and then the code will need to be run again?
The main sheet data will be kept there as a "master" and new data will be added to the bottom. Think of it as an address book mainly and then it sorts by the first letter of each last name to the respective tab. I'm building this for a relative so unfortunately they're set on the method/application.

 

[Joe4]

So, this is like an address book you are building.

You want it so that when they add a new row, it automatically populates the other sheets automatically?
If so, then we need some way of letting Excel know that we are finished entering that row of data.
It can be the population of a certain column in that row, or possibly something else.

How would like you that to work?

 

[traumaticcube]

Yes and yes. That's a good question. I think it could be reliant on the "sort value" column that pulls the first letter from the last name. Once the formula is dragged down I'd say that row would be completed.

 

[Joe4]

Go to the Main sheet, and right-click on the sheet tab name at the bottom of the screen, select "View Code", and paste this VBA code in the resulting VB Editor:

Private Sub Worksheet_Change(ByVal Target As Range)
'   Only run when column J is populated

    Dim rng As Range
    Dim cell As Range
    Dim sht As String
    
'   Check to see if any cells updated in column J
    Set rng = Intersect(Target, Range("J:J"))
    
'   Exit if no updates to column J
    If rng Is Nothing Then Exit Sub
    
'   Loop through updated cells in column J
    For Each cell In rng
'       Exit if header row updated (row 1) or cell is blank
        If (cell.Row = 1) Or (cell.Value = "") Then Exit Sub
'       Copy to appropriate sheet
        sht = cell.Value
        Rows(cell.Row).Copy Sheets(sht).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    Next cell
    
End Sub

This should automatically populate the other sheets as you copy the formula in column J down to your newly entered rows.

 

[traumaticcube]

Go to the Main sheet, and right-click on the sheet tab name at the bottom of the screen, select "View Code", and paste this VBA code in the resulting VB Editor:

Private Sub Worksheet_Change(ByVal Target As Range)
'   Only run when column J is populated

    Dim rng As Range
    Dim cell As Range
    Dim sht As String
   
'   Check to see if any cells updated in column J
    Set rng = Intersect(Target, Range("J:J"))
   
'   Exit if no updates to column J
    If rng Is Nothing Then Exit Sub
   
'   Loop through updated cells in column J
    For Each cell In rng
'       Exit if header row updated (row 1) or cell is blank
        If (cell.Row = 1) Or (cell.Value = "") Then Exit Sub
'       Copy to appropriate sheet
        sht = cell.Value
        Rows(cell.Row).Copy Sheets(sht).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    Next cell
   
End Sub

This should automatically populate the other sheets as you copy the formula in column J down to your newly entered rows.

Worked beautifully, thanks so much! Much cleaner than my monstrosity.

 

[Joe4]

You are welcome!

I hope my methodology makes sense. I documented my code to explain what each step is doing, but let me know if you have any questions.