VBA to copy certain data in a row to a new worksheet based on criteria

[ggtrixabell]

Hi,
I am very new to VBA and have been struggling to find everything I need in one place to complete a task I'd like to do. Any help would be much appreciated.

I have a risk register which captures threats and issues that may occur within my projects. The outcome of those could be a task or an opportunity. I would like to be able to have the team click a button which then runs a macro to look at any risks or issues that have an outcome as 'TASK' and then copy the details to a separate worksheet in my workbook so that the task table can be progressed away from the main capture table. The same goes for any opportunities.
The data would need to be copied and then have the values only pasted to the relevant table in the other 2 worksheets because I have formulas working out the reference number for each new threat/issue in the main table.
My data table on Sheet1 looks like this:

[TABLE="width: 500"]
[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[TD]L[/TD]
[TD]M[/TD]
[TD]N[/TD]
[TD]O[/TD]
[TD]P[/TD]
[TD]Q[/TD]
[TD]R[/TD]
[TD]S[/TD]
[TD]T[/TD]
[TD]U[/TD]
[TD]V[/TD]
[TD]W[/TD]
[TD]X[/TD]
[TD]Y[/TD]
[TD]Z[/TD]
[TD]AA[/TD]
[TD]AB[/TD]
[TD]AC[/TD]
[TD]AD[/TD]
[/TR]
[TR]
[TD]
REF[/TD]
[TD]Project Code[/TD]
[TD]Project Name[/TD]
[TD]Project Lead[/TD]
[TD]Status[/TD]
[TD]Date Raised[/TD]
[TD]TYPE[/TD]
[TD]Raised By[/TD]
[TD]Desc[/TD]
[TD]Impact[/TD]
[TD]Proximity1 (Dept)[/TD]
[TD]Proximity2 (Dept)[/TD]
[TD]Proximity (Timeline)[/TD]
[TD]Cost[/TD]
[TD]Revenue[/TD]
[TD]Quality[/TD]
[TD]Timeframe[/TD]
[TD]Absolute Prob[/TD]
[TD]Absolute Impact[/TD]
[TD]Risk Score[/TD]
[TD]Risk Level[/TD]
[TD]Outcome[/TD]
[TD]Assigned to[/TD]
[TD]Action[/TD]
[TD]Status[/TD]
[TD]Approved By[/TD]
[TD]Approval Date[/TD]
[TD]Completion Date[/TD]
[TD]Notes[/TD]
[TD]Doc Ref Number[/TD]
[/TR]
[TR]
[TD]Calculated using the project code B & Name C with unique number -001 etc[/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]TASK[/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Opportunity[/TD]
[TD]*[/TD]
[TD]*[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[/TABLE]


When the activex button is pressed, I'd like the macro to look for any new "TASK" or "Opportunity" (In column V) that has been added since the last time it was run and to then copy the data in that row but only cells A-I and W-X (I've starred the columns above) if possible, to the corresponding worksheet - Task or Opportunity..

I've managed to get as far as identifying the task or opportunity and copying the row onto the correct worksheet but that's it..

Sorry if this is a complicated explanation, my first time posting too...Any help much appreciated.

Thank you

 

[Fluff]

Hi & welcome to the board.
Could you please answer the following.
1) what are the names of your 3 sheets?
2) does your data start in row2?
3) On the Tasks/Opportunities sheets do you want to keep that data or overwrite it every time?
4) If the answer to 3) is overwrite, do you have headers in row 1 & data in row?
5) Are you happy to have an extra column added to the data sheet?
Cheers

 

[ggtrixabell]

Hi & welcome to the board.
Could you please answer the following.
1) what are the names of your 3 sheets?
2) does your data start in row2?
3) On the Tasks/Opportunities sheets do you want to keep that data or overwrite it every time?
4) If the answer to 3) is overwrite, do you have headers in row 1 & data in row?
5) Are you happy to have an extra column added to the data sheet?
Cheers

Hi Fluff,
Thank you very much
In answer to your questions -
1.) RAID Log (the main sheet) TASK Tracker (for the tasks) & OPP Tracker (for the opportunities)
2.) The data starts in row 11 for all sheets
3.) As long as it only copies the required columns over (A-I and V&W) into rows A-L on the Task and Opp tracker tabs then it should be ok to overwrite the copied data each time and just add any new rows on at the bottom.
4.)I have Headers on all sheets in row 10 each time
5.) Yes, add away

Thank you .
4.)

 

[Fluff]

Give this a go

Sub Fltr_Copy()


    Dim TskSht As Worksheet
    Dim OppSht As Worksheet
    Dim UsdRws As Long
    Dim Crit As Variant

Application.ScreenUpdating = False

    Set TskSht = Sheets("TASK Tracker")
    Set OppSht = Sheets("OPP Tracker")
    
    TskSht.Rows("11:" & Rows.Count).Clear
    OppSht.Rows("11:" & Rows.Count).Clear
    
    With Sheets("Raid Log")
        UsdRws = .Cells.Find("*", After:=.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        .Range("A10:AD10").AutoFilter
        .Range("A10:AD" & UsdRws).AutoFilter Field:=22, Criteria1:="=TASK"
        .Range("A11:I" & UsdRws).SpecialCells(xlVisible).Copy
        TskSht.Range("A11").PasteSpecial xlValues
        .Range("V11:X" & UsdRws).SpecialCells(xlVisible).Copy
        TskSht.Range("J11").PasteSpecial xlValues
        .Range("A10:AD" & UsdRws).AutoFilter Field:=22, Criteria1:="=OPPORTUNITY"
        .Range("A11:I" & UsdRws).SpecialCells(xlVisible).Copy
        OppSht.Range("A11").PasteSpecial xlValues
        .Range("V11:X" & UsdRws).SpecialCells(xlVisible).Copy
        OppSht.Range("J11").PasteSpecial xlValues
        .Range("A10:AD10").AutoFilter
    End With

Application.CutCopyMode = False

End Sub

 

[ggtrixabell]

Hi & welcome to the board.
Could you please answer the following.
1) what are the names of your 3 sheets?
2) does your data start in row2?
3) On the Tasks/Opportunities sheets do you want to keep that data or overwrite it every time?
4) If the answer to 3) is overwrite, do you have headers in row 1 & data in row?
5) Are you happy to have an extra column added to the data sheet?
Cheers

Hi Fluff,
Thank you, that works and brings the TASK lines onto the Task Tracker tab perfectly but nothing comes through for the Opp Tracker tab. I get this error message:

Run-time error '1004'
Application-defined or object-defined error

Also, it seems to leave the rows that have data in column A, on my main page all bunched up..

I really appreciate your help.

 

[ggtrixabell]

Hang on!... It works!! Thank you

 

[ggtrixabell]

Thank you so much, you've made my day!

 

[Fluff]

Glad to help & thanks for the feedback

 

[ggtrixabell]

At the risk of sounding cheeky... just a quick one...

I could do with the data on the main table (Tab - RAID Log) retaining the filter options so we can analyse the open and closed issues. Also, the date formatting for column F doesn't copy over on to the tracker tabs.. Any chance you could have a look at that or direct me please?
Thank you again.

 

[Fluff]

This will keep the Raid sheet filtered on "Opportunity" & format col F (change the part in red to suit)

Sub Fltr_Copy()


    Dim TskSht As Worksheet
    Dim OppSht As Worksheet
    Dim UsdRws As Long
    Dim Crit As Variant

Application.ScreenUpdating = False

    Set TskSht = Sheets("TASK Tracker")
    Set OppSht = Sheets("OPP Tracker")
    
    TskSht.Rows("11:" & Rows.Count).Clear
    OppSht.Rows("11:" & Rows.Count).Clear
    
    With Sheets("Raid Log")
        UsdRws = .Cells.Find("*", After:=.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        .Range("A10:AD10").AutoFilter
        .Range("A10:AD" & UsdRws).AutoFilter Field:=22, Criteria1:="=TASK"
        .Range("A11:I" & UsdRws).SpecialCells(xlVisible).Copy
        TskSht.Range("A11").PasteSpecial xlValues
        .Range("V11:X" & UsdRws).SpecialCells(xlVisible).Copy
        TskSht.Range("J11").PasteSpecial xlValues
        .Range("A10:AD" & UsdRws).AutoFilter Field:=22, Criteria1:="=OPPORTUNITY"
        .Range("A11:I" & UsdRws).SpecialCells(xlVisible).Copy
        OppSht.Range("A11").PasteSpecial xlValues
        .Range("V11:X" & UsdRws).SpecialCells(xlVisible).Copy
        OppSht.Range("J11").PasteSpecial xlValues
    End With
    TskSht.Select
    OppSht.Select False
    Columns(6).NumberFormat = "[COLOR=#ff0000]dd/mm/yyyy[/COLOR]"
    Sheets("Raid Log").Activate



Application.CutCopyMode = False

End Sub