Data Copying

[mariasrg]

Hi

I have a spreadsheet that has multiple tabs - each tab has the same column headers. 2 columns show Risk and Priority where the values can be low, medium or high. If the value of these is High I would like to copy the whole row of data to a summary worksheet within the same spreadsheet - if that makes sense.

Thanks in advance

 

[mariasrg]

 

[mumps]

If all the sheets (except Summary) look the same as the Management sheet, then I can't see why the macro should not work. If you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com I would be able to test the macro on your actual file. Once you do the upload, mark it for 'Sharing' and you will be given a link to the file that you can post here.

 

[mariasrg]

MH VB 2020.xlsm

Shared with Dropbox

www.dropbox.com

 

[mumps]

Click here to download your file.

 

[mariasrg]

Oh my you are amazing - couple of things - I put a high in management for both risk and priority and it puts it on the summary twice - could that be changed to just put it on once - also dont need it for maint & Capex. I know Im a pain

 

[mariasrg]

It also doesnt align to the headings

 

[mumps]

Delete all the "High" values in columns E and F and then replace the previous macro with this one:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Intersect(Target, Sh.Range("E:F")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    If Sh.Name <> "Summary" And Sh.Name <> "Weekly Governance Data" And Sh.Name <> "Maint & CAPEX" Then
        Select Case Target.Column
            Case Is = 5
                If Target = "High" And Target.Offset(, 1) = "" Then
                    Target.EntireRow.Copy Sheets("Summary").Cells(Sheets("Summary").Rows.Count, "A").End(xlUp).Offset(1)
                End If
            Case Is = 6
                If Target = "High" And Target.Offset(, -1) = "" Then
                    Target.EntireRow.Copy Sheets("Summary").Cells(Sheets("Summary").Rows.Count, "A").End(xlUp).Offset(1)
                End If
        End Select
    End If
    Application.ScreenUpdating = True
End Sub