Macro to help with a reporting feature!

[Mr_Car_Lover]

Hi all - I have been trying for a week now through chopping up bits of code to try perform a report function to help with some data analysis but it is hopeless and keeps failing.

I have 3 sheets within my work book:

• Master Data
• Data Input
• Duplicates

All three sheets contains the same headers in row 1, going from column A-->H.

What i would like is a macro which either occurs when data is dropped into or if easier a button is pressed on sheet 'Data Input'.

data will be manually pasted into 'Data Input' into cell A2 --> the macro would be pressed and ideally following happens:

1. The information in 'data input' is compared to existing data in the sheet 'master data' --> if a value in column B (a container number) of 'Data input' matches to a value in column B of 'Master Data' it should be cut and paste to the sheet 'Duplicates' on the next blank row.
2. All remaining data in the 'Data input' sheet should then be pasted onto the next free row in 'Master Data'.
3. The Data Input sheet should then be cleared from A2 onwards.

N.B if possible (dont know if it is) it would be great to have a row blocked out with each paste into the master sheet container todays date in column A!

If someone could help i will be in debt!

Sincerely a useless Excel user

 

[igold]

Does this do what you want. I was not sure what the you wanted done with this line:

N.B if possible (dont know if it is) it would be great to have a row blocked out with each paste into the master sheet container todays date in column A

If the code meets your other requirements, if you could explain further, I am sure we could revise this code...

Sub dupes()

    Dim Rw As Long, DupIndex As Long
    Dim lRowMD As Long, lRowDI As Long, lRowDups As Long
    Dim wsDI As Worksheet: Set wsDI = Worksheets("Data Input")
    Dim wsMD As Worksheet: Set wsMD = Worksheets("Master Data")
    Dim wsDups As Worksheet: Set wsDups = Worksheets("Duplicates")
    Dim arr
    
    Application.ScreenUpdating = False
    lRowMD = wsMD.Cells(Rows.Count, 2).End(xlUp).Row
    lRowDI = wsDI.Cells(Rows.Count, 2).End(xlUp).Row
    lRowDups = wsDups.Cells(Rows.Count, 2).End(xlUp).Row
    
    arr = wsDI.Range("A2:H" & lRowDI)
    wsMD.Range("A" & lRowMD + 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    wsDI.Range("A2:H" & lRowMD).ClearContents
    wsMD.Activate
    lRowMD = wsMD.Cells(Rows.Count, 2).End(xlUp).Row
    For Rw = 1 To lRowMD
        If Cells(Rw, 2) <> "" Then
            DupIndex = WorksheetFunction.Match(Cells(Rw, 2), Range("B1:B" & lRowMD), 0)
                If Rw <> DupIndex Then
                    lRowDups = wsDups.Cells(Rows.Count, 2).End(xlUp).Row
                    Cells(Rw, 1).EntireRow.Copy wsDups.Range("A" & lRowDups + 1)
                    Cells(Rw, 2) = ""
                End If
        End If
    Next
    wsMD.Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Application.ScreenUpdating = True
    
End Sub