how to copy rows (& auto update) to another (existing) worksheet based on criteria


New Member
Nov 25, 2015
Hi All!
Here's what I'm hoping some of you wizards can help me with:

My Boss' wife has a mailing list in Excel which exceeds 500 entries. The Master list contains all the addresses. Columns 9 - 13 have designations of x, g, c, j, and p. If the person gets a mailing for Christmas, an "x" is placed in the x column. If they are part of the garden club, a "g" is placed in the g column, and so on. Each category has its own, separate worksheet (in the same workbook) to generate mail merge invitations, etc. A person can be on one or all of the mailing lists.

She regularly brings me updates. Last spring I semi-automated the address updating process by pasting a very simple "='Wellford Addresses-ALL, MASTER'!E10", etc. This process requires babysitting every time a new entry is made or one deleted, though. And further, she substantially overestimated my skills and now has me doing the mailing list for a non-profit board of which she is a member! This non-profit list has even more columns and year numbers (i.e. 13, 14, 15) are entered in the column instead of letters depending on which year the person donated, or attended or so on.

I am wading into macros for this. Since July I have been studying via Mr. Jelen's book "VBA and Macros for Microsoft Office Excel 2007" but not written any code until this month. I modified some code found on this site, but it isn't doing anything at all and I'm nearing a deadline. I am actually writing in Excel 2010 on Windows 7, but had the book from a class I took 5 years ago.

It seems like I saw a way somewhere on here to link or paste a partial spreadsheet example. If you know of a way I can do that (while changing names and contact info on sheet) please advise and I will do so. The first row contains headers. I'm trying to find a way to link active data for you to see...
Here's what I have. Apologies if it's completely off track. It does seem very long.

Rich (BB code):
Option Explicit
Sub DisributeRowsArrays()
' CGutz November 2015
Dim wAM As Worksheet, wX As Worksheet, wG As Worksheet, wC As Worksheet, wJ As Worksheet, wP As Worksheet
Dim am As Variant, x As Variant, g As Variant, c As Variant, j As Variant, p As Variant
Dim i As Long, lr As Long, amam As Long, xx As Long, gg As Long, cc As Long, jj As Long, pp As Long
Dim n As Long, nr As Long
Set wAM = Worksheets("Wellford Addresses-ALL, MASTER")
Set wX = Worksheets("X-Wellford Addresses")
Set wG = Worksheets("G-Wellford Addresses")
Set wC = Worksheets("C-Wellford Addresses")
Set wJ = Worksheets("J-Wellford Addresses")
Set wP = Worksheets("P-Wellford Addresses")
If wAM.FilterMode Then wAM.ShowAllData
am = wAM.Range("A1").CurrentRegion.Resize(, 13)
n = Application.CountIf(wAM.Columns(9), "x")
ReDim x(1 To n, 1 To 13)
n = Application.CountIf(wAM.Columns(10), "g")
ReDim g(1 To n, 1 To 13)
n = Application.CountIf(wAM.Columns(11), "c")
ReDim c(1 To n, 1 To 13)
n = Application.CountIf(wAM.Columns(12), "j")
ReDim j(1 To n, 1 To 13)
n = Application.CountIf(wAM.Columns(13), "p")
ReDim p(1 To n, 1 To 13)
For i = 1 To UBound(am, 1)
  If am(i, 9) = "x" Then
    xx = xx + 1
    x(xx, 1) = am(i, 1)
    x(xx, 2) = am(i, 2)
    x(xx, 3) = am(i, 3)
    x(xx, 4) = am(i, 4)
    x(xx, 5) = am(i, 5)
    x(xx, 6) = am(i, 6)
    x(xx, 7) = am(i, 7)
    x(xx, 8) = am(i, 8)
    x(xx, 9) = am(i, 9)
    x(xx, 10) = am(i, 10)
    x(xx, 11) = am(i, 11)
    x(xx, 12) = am(i, 12)
    x(xx, 13) = am(i, 13)
  ElseIf am(i, 10) = "g" Then
    gg = gg + 1
    g(gg, 1) = am(i, 1)
    g(gg, 2) = am(i, 2)
    g(gg, 3) = am(i, 3)
    g(gg, 4) = am(i, 4)
    g(gg, 5) = am(i, 5)
    g(gg, 6) = am(i, 6)
    g(gg, 7) = am(i, 7)
    g(gg, 8) = am(i, 8)
    g(gg, 9) = am(i, 9)
    g(gg, 10) = am(i, 10)
    g(gg, 11) = am(i, 11)
    g(gg, 12) = am(i, 12)
    g(gg, 13) = am(i, 13)
  ElseIf am(i, 11) = "c" Then
    cc = cc + 1
    c(cc, 1) = am(i, 1)
    c(cc, 2) = am(i, 2)
    c(cc, 3) = am(i, 3)
    c(cc, 4) = am(i, 4)
    c(cc, 5) = am(i, 5)
    c(cc, 6) = am(i, 6)
    c(cc, 7) = am(i, 7)
    c(cc, 8) = am(i, 8)
    c(cc, 9) = am(i, 9)
    c(cc, 10) = am(i, 10)
    c(cc, 11) = am(i, 11)
    c(cc, 12) = am(i, 12)
    c(cc, 13) = am(i, 13)
  ElseIf am(i, 12) = "j" Then
    jj = jj + 1
    j(jj, 1) = am(i, 1)
    j(jj, 2) = am(i, 2)
    j(jj, 3) = am(i, 3)
    j(jj, 4) = am(i, 4)
    j(jj, 5) = am(i, 5)
    j(jj, 6) = am(i, 6)
    j(jj, 7) = am(i, 7)
    j(jj, 8) = am(i, 8)
    j(jj, 9) = am(i, 9)
    j(jj, 10) = am(i, 10)
    j(jj, 11) = am(i, 11)
    j(jj, 12) = am(i, 12)
    j(jj, 13) = am(i, 13)
  ElseIf am(i, 13) = "p" Then
    pp = pp + 1
    p(pp, 1) = am(i, 1)
    p(pp, 2) = am(i, 2)
    p(pp, 3) = am(i, 3)
    p(pp, 4) = am(i, 4)
    p(pp, 5) = am(i, 5)
    p(pp, 6) = am(i, 6)
    p(pp, 7) = am(i, 7)
    p(pp, 8) = am(i, 8)
    p(pp, 9) = am(i, 9)
    p(pp, 10) = am(i, 10)
    p(pp, 11) = am(i, 11)
    p(pp, 12) = am(i, 12)
    p(pp, 13) = am(i, 13)
  End If
Next i
nr = wX.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
wX.Range("A" & nr).Resize(UBound(x, 1), 13) = x
nr = wG.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
wG.Range("A" & nr).Resize(UBound(g, 1), 13) = g
nr = wC.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
wC.Range("A" & nr).Resize(UBound(c, 1), 13) = c
nr = wJ.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
wJ.Range("A" & nr).Resize(UBound(j, 1), 13) = j
nr = wP.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
wP.Range("A" & nr).Resize(UBound(p, 1), 13) = p
If wAM.FilterMode Then wAM.ShowAllData
End Sub
Last edited by a moderator:

L. Howard

Well-known Member
Oct 16, 2012
Thank you again! That worked! And now I see my error. I was thinking the Count 4 was about placement. But it was where it searched for entries. All good now.
Happy Holidays!

Not sure if you got that correct, in your wording, but probably in your thinking though.

The 4 is the column number on the copy-to sheets last-used row number.
From that row the copied data is displaced one row below that last-used row by the .End(xlUp)(2) and one column to the left by the Offset(,-1).

Without the offset the row data of the 21 columns would be from columns D to X, the offset puts it from columns C to W.

We have to use column 4 because it ALWAYS has an entry in it, whereas column C has many blank rows and the copy will go up to that last entry which is often well up the column from the TRUE last entry in column D.

If C will always have an entry in it (no blanks) as D does, then we could use Count,3 and omit the offset.


Merry Christmas

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.


New Member
Nov 25, 2015
So true, Ha Ha. Wording and thinking = why my imprecise, "big picture" explanations frustrate engineering types (-:
I really do appreciate your more exact description though. When the non-profit decides to incorporate still more columns, I have a very clear path to follow in making those changes.

Merry Christmas, Santa Howard!


New Member
Nov 25, 2015
Santa Howard,
...just when you thought you'd sent me packing, lol...
The Wellford Address Book:
Having received the latest rounds of changes from Boss' Wife I entered them all and reformatted the workbook to make it consistent. You were so kind to provide the 3 row and 4 row formatting code. But since I had to reformat it regardless, and because I can see her wanting to sort by zip code down the pike, I put it into a more standard arrangement. I then pasted in the code you'd written for the Non-Profit and altered it to allow for 5 column categories with corresponding tabs, instead of 10.
Debugging. The buggiest part of programming. I keep getting "subscript out of range, error code 9" in the same exact spot every time:
at " Sheets(.Cells(1, m + 10).Value).Cells(Rows.Count, 1) _
.End(xlUp)(2).Resize(1, 15).Value = Application.Index(varData, n, 0)"

Lots of web searches and changes later it still sticks in the spot. Nearest I can figure is it doesn't feel like I've specified correct parameters on the array.
Can you help me one more time, Ol' buddy 'Ol pal?
Here's the link: Address Book dropbox.xlsm?dl=0
I've scrambled the addresses and removed all phone & email for privacy.

Thank you thank you!

L. Howard

Well-known Member
Oct 16, 2012
Hi Christine,

Try this. Address Book KLMNO issue (1).xlsm?dl=0

Where the names of the sheets match the values of cells K1, L1, M1, N1, O1.

And here are the codes. Not much changed except the red number 2 in this portion

For n = 2 To Sheets.Count
for the WrapText and AutoFit near the bottom of the copy sub.

I re-wrote the clear macros, one for the main sheet to clear ALL copy-to sheet, and one to run on an individual copy-to sheets.


Option Explicit

Sub Copy_Wellford_Address_Book()
'/by Claus@MSPublic

Dim LRow As Long, n As Long, m As Long
Dim varCheck As Variant, varData As Variant

Application.ScreenUpdating = False

With Sheets("Wellford Addresses-ALL, MASTER")
    LRow = .Cells(Rows.Count, 1).End(xlUp).Row
    varCheck = .Range("K2:O" & LRow)
    varData = .Range("A2:O" & LRow)
    For n = LBound(varCheck) To UBound(varCheck)
        For m = LBound(varCheck, 2) To UBound(varCheck, 2)
            If Len(varCheck(n, m)) > 0 Then
                Sheets(.Cells(1, m + 10).Value).Cells(Rows.Count, 1) _
                    .End(xlUp)(2).Resize(1, 15).Value = Application.Index(varData, n, 0)
            End If
        Next m
    Next n
End With

For n = [COLOR="#FF0000"]2[/COLOR] To Sheets.Count
    Sheets(n).UsedRange.WrapText = False

Application.ScreenUpdating = True
End Sub

Sub Clear_All_Copy_Sheets()
'// Assigned to the clear symbol on sheet ("Wellford Addresses-ALL, MASTER")

Dim MyArr As Variant
Dim i As Long

 Dim Reply As VbMsgBoxResult
  Reply = MsgBox("     Do you want to" _
          & vbCr & "CLEAR ALL CONTENTS" _
          & vbCr & "            of Sheets" _
          & vbCr & """W"", ""G"", ""C"", ""J"", ""P"" ? ", _
          vbYesNo + vbQuestion, "All Sheets Clear Alert!")
  If Reply = vbNo Then Exit Sub
  ' A Yes click
  MsgBox "Okay, will clear." '_
MyArr = Array("W", "G", "C", "J", "P")
    For i = LBound(MyArr) To UBound(MyArr)
      On Error Resume Next
      Sheets(MyArr(i)).Range("A2:" & Cells.SpecialCells(xlLastCell).Address). _
           SpecialCells(xlCellTypeConstants, xlTextValues).ClearContents
      Sheets(MyArr(i)).Range("A2:" & Cells.SpecialCells(xlLastCell).Address). _
           SpecialCells(xlCellTypeConstants, xlNumbers).ClearContents
    Next 'i
    Sheets("Wellford Addresses-ALL, MASTER").Range("P1").Select
Application.ScreenUpdating = True
End Sub

Sub One_Sheet_Clear()
'//  Assigned to each delete symbol on each copy-to sheet

       On Error Resume Next
  Range("A2:" & Cells.SpecialCells(xlLastCell).Address). _
     SpecialCells(xlCellTypeConstants, xlTextValues).ClearContents
  Range("A2:" & Cells.SpecialCells(xlLastCell).Address). _
     SpecialCells(xlCellTypeConstants, xlNumbers).ClearContents

End Sub


New Member
Nov 25, 2015


I plugged your changes into my (formerly your) code. One change, other than the clear sheet(s) code. Ha! Basically it just didn't like a column header of "X".
What would I do without you, Howard?
Boss' Wife is coming in after lunch and I'll be happy to hand this off to her.
PS: I'm in interviews for a new job. I may have to take you with me!
I'll have to buy a bar for all the Beefeaters I owe you, lol!

L. Howard

Well-known Member
Oct 16, 2012
Okay, good. Glad it is working for you.

Good luck with the interviews, and no need for the bar purchase... see post #40. An olive tree maybe?



New Member
Nov 25, 2015
Do olive trees grow well in Oregon? They're all over the Phoenix area - different temperate zone but otherwise might be similar sun and dirt. I'll send you one if you want. Potted or seedling? (small potted. I'm just a lowly admin.)

PS: I'm on round 2 of the interviews. Thanks for the luck wish (-:

Watch MrExcel Video

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back