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

 

[GutzyRose]

But of course, the olives are the best part! I usually (and by usually I mean a few times a year) prefer the vodka to to the gin. Anyway, can't get much further than Oregon. And thank you again. I hope to not have to ask more questions about this. But if my weekend finishing doesn't fly I may be back.
And I am the early bird here, so time for me to call it a week. Already at my 9 hours today (-:

Thank you again Howard!

 

[L. Howard]

Hi Christine,

Just a quick follow up with a faster code for the other workbook, the one that is NOT the Non-Profit workbook.

https://www.dropbox.com/s/f9s05v4o485mp0n/Wellford Tester ver 3 faster code.xlsm?dl=0

The gray area shows the size of the data block that will be transferred.

You can us most any if not all keyboard characters, though I have not tested all of them, to key in a data block to a sheet/s.

Yellow star for the macro, circled black X for a clear of all five sheets.

Timed code runs of ALL data blocks to ALL five sheets is 3 seconds on my machine, 630 blocks 2520 rows. Less than a second on another computer.

Howard


Here is the code.

Option Explicit


Sub Copy_ALL_MASTER_3()
'/ by Claus @ MSPublic
Dim LRow As Long, n As Long, m As Long
Dim varCheck As Variant
Dim dest As Range, LRowD As Range

'Dim st As Double
'st = Timer

Const shName = "-Wellford Addresses"

 

With Sheets("Wellford Addresses-ALL, MASTER")

    LRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 3

    varCheck = .Range("I1:M" & LRow)

End With
 

For n = 2 To UBound(varCheck) Step 4

    For m = LBound(varCheck, 2) To UBound(varCheck, 2)

        If Len(varCheck(n, m)) > 0 Then

                With Sheets(varCheck(1, m) & shName)

                    Set LRowD = .Cells(Rows.Count, 1).End(xlUp)

                    If LRowD.Row = 1 And IsEmpty(LRowD.Offset(1, 0)) Then

                        Set dest = LRowD.Offset(1, 0)

                    Else

                        Set dest = LRowD.Offset(4, 0)

                    End If

                End With

                
                dest.Resize(4, 8).Value = _
                    Sheets("Wellford Addresses-ALL, MASTER").Cells(n, 1).Resize(4, 8).Value

        End If

    Next m

Next n
'Range("P" & Rows.Count).End(xlUp)(2) = Format(Timer - st, "0.000")
'MsgBox Format(Timer - st, "0.000")
End Sub

 

[GutzyRose]

I'll see if I can run that this week, maybe today. End of year is always busy.
The non-profit code is working great. I'm going to hand it off to them - probably today and walk them through it within a week. I had to update assigning the macros but that was simple.
Can you tell me, how did you get that file size so much smaller? Compressing only marginally downsizes. That file was made by tacking a batch of workbooks together into one. Otherwise I can't say why it'd be so astronomically huge considering the type of data it is.
Happy Monday,
Christine

 

[L. Howard]

Can you tell me, how did you get that file size so much smaller? Compressing only marginally downsizes. That file was made by tacking a batch of workbooks together into one. Otherwise I can't say why it'd be so astronomically huge considering the type of data it is.
Happy Monday,
Christine

Hi Christine,

The very first workbook you posted a link to was pretty large for "not so much" data. You had some color formatting, but I believe you were moving data to the other sheets using formulas. If I recall, there was A TON of formulas. I selected the entire worksheets and hit Delete. Then on each sheet I did a Ctrl + End to find the "used area". Seems the used area was around 12 to 15 columns and 7500 rows, give or take.

I selected the first row across the 15 columns and did a Ctrl + Shift + Down arrow. With 15 column by 1,000,000 + rows selected Home tab > Delete > Delete Cells > check Shift Upward > OK. Most sheets said it did not have the resources to do this... etc. etc. but ground it's way through.

That worked on about three of the sheets then the workbook froze up and I had to bail out with Ctrl + Alt + Delete. Had I been successful in this deletion process, I would have then saved the workbook, closed it, (shut down Excel, but not sure you need to close Excel) and restarted Excel and re-open the workbook.

After second time of freezing up, I elected to open a new workbook, Named it & saved it as Macro Enabled Workbook.xlsm. Then merely copied everything to the new workbook, sheet names, headers, and the data from the main sheet. Copied the macros to an inserted standard module.

The workbook went from xxMB to xxxKB. Then increased slightly after data was copied to the previously blank secondary sheets.

You can google something like this and there will be several articles on the mysterious growth of workbooks.

Sudden Increases in Workbook File Size

Happy Monday to you also, it is my favorite day-o-the-week. The New York Times crossword puzzle is almost always completely doable by me on this day.

Howard

 

[GutzyRose]

I'm uncertain if they make it easier on Monday or if the brain break helps! Many years ago I was a crossword fanatic. Stopped for reasons also in the past, but haven't picked it back up. Kudos for getting through the puzzle regularly.
And I really do find most Mondays happy. A new day, new page, upward and onward I suppose (-:

Yes, that first address book can be at row 700 and the right hand scroll bar still sits at the top of the page. It makes navigating more difficult than need be. I did the delete method you discussed which dropped it to <1MB, but it's still unusually huge. I think I'll do what you did and just paste into an entirely new book. It's size and speed are ridiculously slow considering there's no pics or rocket science in it.

I think we have an Excel demon here at the office. I have a personal workbook in which I keep my hours and budget (boring to be so structured but you'd be amazed what one can accomplish tracking the finances thus). It's always been pretty nimble, even with interest estimates and forecasts. But a few months ago it started clogging, hesitating. In fact this morning I pasted a new book because of that. It's already worth the calcs I had to rework!

Anyway - I digress. I'll run that code this afternoon or tomorrow. I am resting my gray matter (too much perhaps) pasting number indexes for a few dozen covenant books which need assembled for a meeting. Yawn (-:

 

[GutzyRose]

Hi Howard!
I hope you are having a lovely December and whatever holiday tradition you celebrate!

I'm hoping you can help me with the non-profit mailing list 1 more time?

I sent it to them. They did some stuff. And then last night we met. They want to make one change which I am trying to incorporate on my own. You remember those 3 columns (A:C) which had a mystery use? They now want to enter casual names into column C and have the data pull to the correct sheet as well.
So I am getting partially there by changing a couple of parameters in your code. It's pulling what's in C and putting it in the right place, But it isn't pulling ALL of the data and I can't seem to find what is triggering it to stop when it should go!

Pasting your old code:
Option Explicit


Sub Copy_Non_Profit()
'/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("!ALL CP!")
LRow = .Cells(Rows.Count, 4).End(xlUp).Row

varCheck = .Range("N2:W" & LRow)
varData = .Range("D2:W" & 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 + 13).Value).Cells(Rows.Count, 4) _
.End(xlUp)(2).Resize(1, 20).Value = Application.Index(varData, n, 0)
End If

Next m

Next n

End With


For n = 3 To Sheets.Count
Sheets.UsedRange.WrapText = False
Sheets.Columns("A:W").AutoFit
Next


Application.ScreenUpdating = True
End Sub

And with my changes:

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


Application.ScreenUpdating = False


With Sheets("!ALL CP!")
LRow = .Cells(Rows.Count, 3).End(xlUp).Row

varCheck = .Range("N2:W" & LRow)
varData = .Range("C2:W" & 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 + 13).Value).Cells(Rows.Count, 3) _
.End(xlUp)(2).Resize(1, 21).Value = Application.Index(varData, n, 0)
End If

Next m

Next n

End With


For n = 3 To Sheets.Count
Sheets.UsedRange.WrapText = False
Sheets.Columns("A:W").AutoFit
Next


Application.ScreenUpdating = True
End Sub

and a new dropbox link:
https://www.dropbox.com/s/lul2u763b...lford Non Profit Test Book Drop Box.xlsm?dl=0



Can you help with this? I'll keep working on my end. But I've changed what looks like it should work and I'm not seeing why it pulls some, but not all info.
Thank you kindly,
Christine

 

[GutzyRose]

Hi Howard,
Here's a new dropbox link with the go-to sheets cleared, and the order of things formatted. It looks like it's only pulling those with data in the newly added column C "Informal Name(s)". But every now & then it pulls something else. It never pulls and copies everything. I can't figure it out...
https://www.dropbox.com/s/lul2u763b...lford Non Profit Test Book Drop Box.xlsm?dl=0
I know it's a busy season. But maybe it will be something simple.
Christine

 

[L. Howard]

Hi Christine,

Give this a try, the "old code" lines are commented out just below the "new code" lines.

Option Explicit

Sub Copy_Non_Profit()
'/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("!ALL CP!")
    LRow = .Cells(Rows.Count, 4).End(xlUp).Row
    
    varCheck = .Range("N2:W" & LRow)
    varData = .Range("C2:W" & LRow)
             '/ .Range("D2:W" & 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 + 13).Value).Cells(Rows.Count, 4) _
                    .End(xlUp)(2).Offset(, -1).Resize(1, 21).Value = Application.Index(varData, n, 0)
                 '/ .End(xlUp)(2).Resize(1, 20).Value = Application.Index(varData, n, 0)
                 
            End If
            
        Next m
        
    Next n
    
End With

For n = 3 To Sheets.Count
    Sheets(n).UsedRange.WrapText = False
    Sheets(n).Columns("A:W").AutoFit
Next

Application.ScreenUpdating = True
End Sub

 

[GutzyRose]

Good morning Howard,
Oh that's interesting you kept the "Count,4" but added an "Offset(,-1).
I'll run it through in a bit.
Thank you!
Christine

 

[GutzyRose]

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