SOLVED

is there a way to make sure my macro doesn't duplicate data

Copper Contributor

I posted in another blog and haven't received a response so I am not sure that what I am asking can be done.   I used code from the following article https://docs.microsoft.com/en-us/office/vba/api/excel.range.copy to partially accomplish my goal but I have a few more questions.

I have a file where I dump data every month and then extrapolate data on other tabs. Within that file, I have a "master" sheet where I do the data dump and I was able to copy the macro from the article above and amend it to send data based on data in a specific column (TERR) to a variety of sheets. What I need to accomplish is this - I would like to continue adding to the same sheets each month but if I run the macro, it will keep adding all of the same data every time (in other words, I don't want it to add the previously added data every time I add new data to the master sheet and then run the macro). Is there a way to add to the macro so that it does not add duplicate rows? I could use a combination of two other columns (Item and Invoice) to look at whether or not the data is duplicate. Also, there are columns of data that have formulas in them and when I paste the data to my other sheets, I would like to paste special values instead of the formula. The goal is that I can then sort and filter the data on the other sheets in a variety of ways and give that information to other people. Thanks for your help!!!

 

Public Sub CopyRows()
    Sheets("MORSE Item Sales Analysis").Select
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To FinalRow
        ThisValue = Cells(x, 29).Value
        If ThisValue = "FORN" Then
            Cells(x, 1).Resize(1, 48).Copy
            Sheets("FORN").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("MORSE Item Sales Analysis").Select
        ElseIf ThisValue = "GRLK" Then
            Cells(x, 1).Resize(1, 48).Copy
            Sheets("GRLK").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("MORSE Item Sales Analysis").Select
        ElseIf ThisValue = "NEST" Then
            Cells(x, 1).Resize(1, 48).Copy
            Sheets("NEST").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("MORSE Item Sales Analysis").Select
        ElseIf ThisValue = "NWST" Then
            Cells(x, 1).Resize(1, 48).Copy
            Sheets("NWST").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("MORSE Item Sales Analysis").Select
        ElseIf ThisValue = "PLNS" Then
            Cells(x, 1).Resize(1, 48).Copy
            Sheets("PLNS").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("MORSE Item Sales Analysis").Select
        ElseIf ThisValue = "NEST" Then
            Cells(x, 1).Resize(1, 48).Copy
            Sheets("NEST").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("MORSE Item Sales Analysis").Select
        ElseIf ThisValue = "NWST" Then
            Cells(x, 1).Resize(1, 48).Copy
            Sheets("NWST").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("MORSE Item Sales Analysis").Select
        End If
    Next x
End Sub

 

 

9 Replies

@Suzanne25811 

 

Please give this a try and see if this works for you...

 

Sub CopyRows()
    Dim wsSource    As Worksheet
    Dim wsDest      As Worksheet
    Dim shArr       As Variant
    Dim sh          As Variant
    Dim FinalRow    As Long
    Dim NextRow     As Long
    
    Application.ScreenUpdating = False
    
    Set wsSource = ThisWorkbook.Worksheets("MORSE Item Sales Analysis")
    wsSource.AutoFilterMode = False
    FinalRow = wsSource.Cells(Rows.Count, 1).End(xlUp).Row
    
    shArr = Array("FORN", "GRLK", "NEST", "NWST", "PLNS")
    
    With wsSource.Range("A1").CurrentRegion
        For Each sh In shArr
            .AutoFilter field:=29, Criteria1:=sh
            If .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
                Set wsDest = ThisWorkbook.Worksheets(sh)
                wsDest.Range("A1").CurrentRegion.Offset(1).ClearContents
                wsSource.Range("A2:AB" & FinalRow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A2")
            End If
        Next sh
    End With
    wsSource.AutoFilterMode = False    
    Application.ScreenUpdating = True    
    MsgBox "Task Completed!", vbInformation
End Sub

@Subodh_Tiwari_sktneer thank you for your help.  Do I insert this after all of the code I showed in my message or do I need to insert this for each section I reference in the code?  Once I know what to do with it, I will follow up to let you know how it works.

 

I appreciate you! 

best response confirmed by Suzanne25811 (Copper Contributor)
Solution

@Suzanne25811 

 

Just replace your existing code with the proposed code and see if that works for you.

It worked in my test file!!! Thank you SO much!!!
You're welcome! Glad it worked as desired.

@Subodh_Tiwari_sktneer 

Good morning!

Yesterday, I added a couple more territories.  Adding the territories worked, I ran the macro and it added the info to the appropriate tabs.   Then I noticed that I was missing columns at the end - when I originally started this there were 29 columns and we have added more so the sheet is now 45 columns wide.  

 

This morning I updated the macro to reflect 45 columns.  I tried re-running the macro but it did not add the "missing" info.  I deleted the information off the tabs, saved the file, and re-ran the macro again but nothing at all transferred to my other sheets FORN, GRLK, NEST, etc.  Can you help?

 

Sub CopyRows()
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim shArr As Variant
Dim sh As Variant
Dim FinalRow As Long
Dim NextRow As Long

Application.ScreenUpdating = False

Set wsSource = ThisWorkbook.Worksheets("MORSE Item Sales Analysis")
wsSource.AutoFilterMode = False
FinalRow = wsSource.Cells(Rows.Count, 1).End(xlUp).Row

shArr = Array("FORN", "GRLK", "NEST", "NWST", "PLNS", "SEST", "SWST", "WCAN", "ECAN")

With wsSource.Range("A1").CurrentRegion
For Each sh In shArr
.AutoFilter field:=46, Criteria1:=sh
If .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
Set wsDest = ThisWorkbook.Worksheets(sh)
wsDest.Range("A1").CurrentRegion.Offset(1).ClearContents
wsSource.Range("A2:AS" & FinalRow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A2")
End If
Next sh
End With
wsSource.AutoFilterMode = False
Application.ScreenUpdating = True
MsgBox "Task Completed!", vbInformation
End Sub

 

@Suzanne25811 

You correctly tweaked the following line...

wsSource.Range("A2:AS" & FinalRow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A2")

 

Since you tweak another line as below...

.AutoFilter field:=46, Criteria1:=sh

 

Are you sure that column AT contains the Territories? 46 in the above line of code means column AT.

 

ohhhh, got it!! I just needed to update the range but leave the filter alone. that worked! not sure what I was thinking when I changed the 29 to 46..... thanks again for your help!
1 best response

Accepted Solutions
best response confirmed by Suzanne25811 (Copper Contributor)
Solution

@Suzanne25811 

 

Just replace your existing code with the proposed code and see if that works for you.

View solution in original post