Copying cells into a new sheet without duplictaes

MIB

New Member
Joined
Jun 15, 2021
Messages
11
Office Version
  1. 365
  2. 2011
Platform
  1. Windows
I have never done VBA before, but found a code online to copy rows to a new sheet based on cell value. My problem is is that the source sheet is constantly being updated and every time I run teh macro it copies all teh rows all over again instead of just the newly inputted ones.
This is the code I am using. Is there any way to make it so it only transfers rows that are not already at the destination sheet?
Sub SHOESHOW()
'Updated by Extendoffice 2017/11/10
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("All Shipments").UsedRange.Rows.Count
J = Worksheets("Shoe Show").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Shoe Show").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("All Shipments").Range("F1:F" & I)

Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) Like "*SHOE SHOW*" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Shoe Show").Range("A" & J + 1)
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub

Thanks!!
 
And if I want to run different macros based on different values in different columns, then I can just change anywhere where it says "Shoe Show" to the new value and anywhere where it says "F" to the new column and it will work?
You could create other IF...THEN blocks, but if you want to check other columns, you will need to take this line into account too:
Rich (BB code):
    If Target.Count > 1 Or Target.Column <> 6 Then Exit Sub
Note that the "6" refers to the 6th column (column F).
 
Upvote 0

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
For example, I also have this VBA in the worksheet:
Sub WTI()
'Updated by Extendoffice 2017/11/10
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("All Shipments").UsedRange.Rows.Count
J = Worksheets("WTI").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("WTI").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("All Shipments").Range("Q1:Q" & I)

Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "WTI" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("WTI").Range("A" & J + 1)
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub

The "WTI" Value appears in column G in "All Shipments". Can I replace, in the code you sent me, "Shoe Show" with "WTI" and "F" with "G" and that "6" with "7", it will work also?
 
Upvote 0
Can they both be running at the same time?
 
Upvote 0
You would make two distinct blocks of code in the one procedure, like this:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim nr As Long

'   Exit code if multiple cells updated at once
    If Target.Count > 1 Then Exit Sub
   
'   Run if column F updated
    If Target.Column = 6 Then
'       See if value just updated in column F contains "SHOE SHOW"
        If Target.Value Like "*SHOE SHOW*" Then
'           Find next available row on "Shoe Show" sheet
            nr = Sheets("Shoe Show").Cells(Rows.Count, "F").End(xlUp).Row + 1
'           Copy data
            Target.EntireRow.Copy Sheets("Shoe Show").Cells(nr, "A")
        End If
    End If

'   Run if column G updated
    If Target.Column = 7 Then
'       See if value just updated in column G contains "WTI"
        If Target.Value Like "*WTI*" Then
'           Find next available row on "WTI" sheet
            nr = Sheets("WTI").Cells(Rows.Count, "G").End(xlUp).Row + 1
'           Copy data
            Target.EntireRow.Copy Sheets("WTI").Cells(nr, "A")
        End If
    End If

End Sub
 
Upvote 0
Thank you so much for all your help!!! Really means a lot!:)
 
Upvote 0
You are welcome.

If it solves your issue, you can mark the post with the solution as the solution.
 
Upvote 0
One last question, you don't need to answer if you don't have time, You have already done so much. I have 3 different possible values that go into column G and I want to copy each to their own sheet. "WTI", "G&J", and "NRT". I have VBAs for each like the one I previously sent for "WTI". So depending on which on of those three value is inserted in column G, can I move them to their own sheets? The sheet name for "NRT" is NRT and for "G&J" its G&J.
 
Upvote 0
One last question, you don't need to answer if you don't have time, You have already done so much. I have 3 different possible values that go into column G and I want to copy each to their own sheet. "WTI", "G&J", and "NRT". I have VBAs for each like the one I previously sent for "WTI". So depending on which on of those three value is inserted in column G, can I move them to their own sheets? The sheet name for "NRT" is NRT and for "G&J" its G&J.
Are the values in column G EXACTLY equal to "WTI", "NRT", "G&J", or do you need to use Wild Cards?
If you do not need to use wild cards, we can do it pretty easily like this:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim nr As Long

'   Exit code if multiple cells updated at once
    If Target.Count > 1 Then Exit Sub
   
'   Run if column F updated
    If Target.Column = 6 Then
'       See if value just updated in column F contains "SHOE SHOW"
        If Target.Value Like "*SHOE SHOW*" Then
'           Find next available row on "Shoe Show" sheet
            nr = Sheets("Shoe Show").Cells(Rows.Count, "F").End(xlUp).Row + 1
'           Copy data
            Target.EntireRow.Copy Sheets("Shoe Show").Cells(nr, "A")
        End If
    End If

'   Run if column G updated
    If Target.Column = 7 Then
 '      Check possible values of column G
        Select Case Target.Value
            Case "WTI", "NRT", "G&J"
'               Find next available row on sheet
                nr = Sheets(Target.Value).Cells(Rows.Count, "G").End(xlUp).Row + 1
'               Copy data
                Target.EntireRow.Copy Sheets(Target.Value).Cells(nr, "A")
        End Select
    End If

End Sub
 
Upvote 0
Solution
That worked perfectly!! Thank you again for everything!!
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,202
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top