Yet another COPY Row if Cell = Thread

[Simia]

Hi Everyone,

I have been lurking the forums for a few days now and have tried various snippets but coding just isn't something that comes to me easily. have tried various snippets from here and other sources, with and without edits, but trying to figure out where some of this stuff should be going in the VBA editor is sending me batty.

My wife helped me with an IF query which kind of did the job but also left lots of "FALSE" statements and "0" etc which did entirely fit my purpose.

So here is my scenario.

I have a large Spreadsheet for volunteer management.

There are close to 1000 rows and approximately 34 odd columns of data.

I have a number of sheets the main one being "Volunteer_Master". This is the sheet where I first enter all the data and create a volunteer profile. The information on it updates regularly.

We have various columns for different activities the volunteer participate in. ie Columns K L M N have the headings Activity1, Activity2, Activity3, Activity4

Each volunteer has a "1" placed in the column of the corresponding activity/activities they participate in

There are also corresponding Worksheets Activity1, Activity2, Activity3, Activity4.

What I would like to do is automate the duplication and updating of date from the "Volunteer_Master" to the corresponding activity sheets.

Here is a copy of my sample data from Volunteer_Master. As you will see some volunteers may undertake multiple activity types so therefore need to appear in multiple locations.

SURNAME FIRST NAME(S) STREET ADDRESS SUBURB STATE PCODE RESIDENTIAL (if diff) HOME PH MOBILE EMAIL Activity1 Activity2 Activity3 Activity4
Volunteris Jim Cheer Tree Laneway NSW 5515 123456 98765 jvolun@volun.com 1 1
Helperism Jane PO BOX 111 Mysteryland WA 4458 77 Beach rd 56788 43210 1
laptopimus Primus 33 Hilltop Hoodsville NSW 3321 231879 876543 laptopimus@prime.com 1
sample data1 55datamus excelville SA 2222 876565 11128889 1 1


Is there anything you can do to help me achieve this? My wife suggests I need a macro but says it is beyond her abilitie, and it is certainly beyond my without some careful guidance.

 

[Simia]

This should do the trick then

Sub MM2()
Dim ws As Worksheet, lr As Long, lr2 As Long, r As Long
Application.ScreenUpdating = False
lr = Sheets("Volunteer_Master").Cells(Rows.Count, "A").End(xlUp).Row
For Each ws In Worksheets
    If Len(ws.Name) <= 5 Then
        ws.Activate
        lr2 = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
        If lr2 > 1 Then Rows("2:" & lr2).Delete
    End If
Next ws
Sheets("Volunteer_Master").Activate
For Each c In Range("K2:N" & lr)
    If c.Value = 1 Then
        lr2 = Sheets(Cells(1, c.Column).Value).Cells(Rows.Count, "A").End(xlUp).Row
        Rows(c.Row).Copy Sheets(Cells(1, c.Column).Value).Range("A" & lr2 + 1)
        lr2 = Sheets(Cells(1, c.Column).Value).Cells(Rows.Count, "A").End(xlUp).Row
    End If
Next c
Application.ScreenUpdating = True
End Sub

testing now....

So it looks like

If Len(ws.Name) <= 5 Then

is the magic line to achieve this? ios the saying if the worksheet name is equal to or less than 5 characters - clear it!?

 

[Michael M]

Correct !!

 

[Simia]

Im getting an out of range error - trying to debug now

 

[Michael M]

Make sure the Names of the Activities at the top of the column on the Master sheet, exactly match the actual Sheet names !!
AND
Are the Activity names in the FIRST row of the Column ??

 

[Simia]

Make sure the Names of the Activities at the top of the column on the Master sheet, exactly match the actual Sheet names !!
AND
Are the Activity names in the FIRST row of the Column ??

Have triple checks the spelling for any typos.

Activity names are in the second row not the top row.

 

[Michael M]

Ok....

Sub MM2()
Dim ws As Worksheet, lr As Long, lr2 As Long, r As Long
Application.ScreenUpdating = False
lr = Sheets("Volunteer_Master").Cells(Rows.Count, "A").End(xlUp).Row
For Each ws In Worksheets
    If Len(ws.Name) <= 5 Then
        ws.Activate
        lr2 = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
        If lr2 > 1 Then Rows("2:" & lr2).Delete
    End If
Next ws
Sheets("Volunteer_Master").Activate
For Each c In Range("K3:N" & lr)
    If c.Value = 1 Then
        lr2 = Sheets(Cells(2, c.Column).Value).Cells(Rows.Count, "A").End(xlUp).Row
        Rows(c.Row).Copy Sheets(Cells(2, c.Column).Value).Range("A" & lr2 + 1)
        lr2 = Sheets(Cells(2, c.Column).Value).Cells(Rows.Count, "A").End(xlUp).Row
    End If
Next c
Application.ScreenUpdating = True
End Sub

 

[DocAElstein]

Hi Michael and Simia
. I am learning VBA by lurking and occasionally taking part in Threads here. This is one Thread I was following and have got some nice tips from Michael’s codes.
………………………………………….
@ Simia: I think Michael has ( or depending on your next response is very close to ) a perfect solution for you.
. I just wanted to suggest an additional solution, which I have some codes for.
. This would work as follows
. You have your main File which includes sheets Volunteer_Master and Dashboard InRegion OutofRegional Calculations OriginalDataSheet OldData. These would always be preserved.
.
. Every time you have new data you add this to your Volunteer_Master. So the Volunteer_Master would be a complete record of your entire data to date.
. At some point later at your convenience you run a VBA code which produces for you new sheets with names LB, DK, IB, SS, OW, EVT, SPT, OW_PH, PP, BW, SCT etc, . This code would then copy to the new made sheets all the data You wish, ( the entire row, or some specified column range ) for volunteers making the appropriate activity as indicated by the 1 in that activity column.
. At the start of running the code all the Activity sheets are deleted as they will be newly created.
. It actually works very similar to Michael’s, but uses a different method of Filtering which I am practicing at the moment.
.
. In the practice then if you use this alternative approach, then just before running the code you could resave your current file under a new name with possibly the date in it and save as a .xlsx or .xls type so that the macro in it will no longer work. Then close that File. You then have a safe “back – up” .
Then you reopen the original file and run the macro to produce a full up to date file.
.
. I find it sometimes useful to have an additional solution which looks at the problem from a different angle using different methods etc.
. If you would like me to do an alternative code for you, then let me know.

Alan
Bavaria