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

[GutzyRose]

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.

Option Explicit
Sub DisributeRowsArrays()
' CGutz November 2015
' http://www.mrexcel.com/forum/excel-...s-move-rows-another-sheet-based-criteria.html
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

 

[L. Howard]

Howard,
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!
Christine

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.

Howard

Merry Christmas

 

[GutzyRose]

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!
Christine

 

[GutzyRose]

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: https://www.dropbox.com/s/3b8a637nbchqwfd/Wellford Address Book dropbox.xlsm?dl=0
I've scrambled the addresses and removed all phone & email for privacy.

Thank you thank you!
Christine

 

[L. Howard]

Hi Christine,

Try this.

https://www.dropbox.com/s/00ae004i3bzhan3/Wellford 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.

Howard

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
    Sheets(n).Columns("A:O").AutoFit
Next

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

  Range("A2").Select
End Sub

 

[GutzyRose]

(-:
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!
XO
Christine

 

[L. Howard]

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?

Howard

 

[GutzyRose]

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.)
Christine

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

 

[L. Howard]

No gifts, just kidding.

Howard