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.

 

[Michael M]

Was the "volunteer Master the active sheet when you ran the macro, as I suggested in post #8
Also the code need to be pasted in "This Workbook" module NOT the Vol Master sheet ??


Further
Is the master sheet labelled EXACTLY like you posted
"Volunteer_Master"

 

[Simia]

Was the "volunteer Master the active sheet when you ran the macro, as I suggested in post #8

Yes it was

Also the code need to be pasted in "This Workbook" module NOT the Vol Master sheet ??

Ok I have fixed that up now

Further
Is the master sheet labelled EXACTLY like you posted
"Volunteer_Master"

Yes

I have 4 Sheets

Volunteer_Master
Activity1
Activity2
Activity3
Activity4

I have the Volunteer_Master Page open.

I ran the macro, I have run it and it says "Subscript Out of Range"

 

[Michael M]

If it still clearing the master sheet, the syntax of the Master sheet name is incorrect.
Make sure there are no extra leading / trailling spaces in the name AND there is only one underscore in the name.
Basically what is happening is the code doesn't find "Volunteer_Master" so removes it's contents along with all the others

 

[Michael M]

IF you are getting a Subscript out of range error, it means the sheet called "Volunteer_Master" doesn't exist.
So as mentioned earlier there is something wrong with the syntax of the Tab name for that sheet !!

 

[Simia]

IF you are getting a Subscript out of range error, it means the sheet called "Volunteer_Master" doesn't exist.
So as mentioned earlier there is something wrong with the syntax of the Tab name for that sheet !!

Its all good and working - however I have a dashboard and some other worksheets and these keep getting cleared as well.

Is there a way to restrict this to only clearing the "activity" worksheets?

 

[Michael M]

Ok, try this
It will clear any Sheet with "Activity" in the sheet name !!

Sub MM1()
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 ws.Name <> "Volunteer_Master" And InStr(ws.Name, "Activity") 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

 

[Simia]

Ok, try this
It will clear any Sheet with "Activity" in the sheet name !!

Sub MM1()
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 ws.Name <> "Volunteer_Master" And InStr(ws.Name, "Activity") 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

Michael I can not believe how quick you pull this stuff together - you are amazing!

From the first macro I was able to work out the ranges reference for the columns etc, so I was able to extend and implement for my full variety of Activity Sheets. The problem is the actually Workbook doesn't actually have worksheets named "activity 1" "activity 2" etc.

They are named by abbreviations of what the actually activity is....... LB, IB, SS, OW etc

So my hopefully last question to bug you for assistance is this.

Can the range (or a similar line) that is referenced for the copy

For Each c In Range("K2:P" & lr)

be used in a similar manner to specify the sheets for clearing?

Regards,
MC

 

[Michael M]

Depends on how many activities there are ??
AND do they all have 2 letter sheet names....and maybe the sheets to be preserved don't ??
Might be easier to exclude the sheets that don't need clearing....how many of them are ??

 

[Simia]

Depends on how many activities there are ??
AND do they all have 2 letter sheet names....and maybe the sheets to be preserved don't ??
Might be easier to exclude the sheets that don't need clearing....how many of them are ??

At this point in time there are 11 Activity work sheets
Their names are LB, DK, IB, SS, OW, EVT, SPT, OW_PH, PP, BW, SCT

The other sheets to be preserved are
-Volunteer_Master
-Dashboard
-InRegion
-OutofRegional
-Calculations
-OriginalDataSheet
-OldData

 

[Michael M]

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