VBA to move predifined number of records to a new sheet

[Kpersen]

Good day everyone.

I have a challenging question on VBA. I have a table that contains approximately 3000 rows of customers (customer name in column F) that are allocated to about 20 different location codes in the US (location code is column B) Each week I need to move a predefined number of customers for each location code from this table to a new sheet. The number of customers to be moved for each location is predefined in a separate table. I must make sure that once the predefined number of customers for each location code is moved they are no longer in the original table. Additionally I must ensure that if at any time the number of predefined records is not available to move the macro will move what is left and skip the location if there are no customers available at all. I have look in the forum but found nothing that would work. Does anyone have any suggestions?

 

[DanteAmor]

Try this please

Sub DAM_Select_Location_2()
  Dim sh As Worksheet, s2 As Worksheet
  Dim c As Range, r As Range, n As Long, tope As Variant, wRow As Long
  
  Application.ScreenUpdating = False
  Set sh = Sheets("Master List")
  Set s2 = Sheets("Weekly Contact Count")
  sh.Select
  For Each c In s2.Range("A2", s2.Range("A" & Rows.Count).End(xlUp))
    tope = c.Offset(, 1)
    sh.ListObjects("Table1").Range.AutoFilter Field:=4, Criteria1:=c
    n = 0
    wRow = 0
    On Error Resume Next
    For Each r In sh.ListObjects("Table1").DataBodyRange.SpecialCells(xlCellTypeVisible).Rows
      wRow = r.Row
      n = n + 1
      If n = tope Then Exit For
    Next
    On Error GoTo 0
    If wRow > 0 Then
      sh.Range("A2:L" & wRow).SpecialCells(xlCellTypeVisible).Copy Sheets("New List").Range("A" & Rows.Count).End(xlUp)(2)
      sh.Range("A2:L" & wRow).EntireRow.Delete
    End If
  Next
  On Error Resume Next
  sh.ShowAllData
  sh.AutoFilterMode = False
  Application.ScreenUpdating = True
  MsgBox "End"
End Sub

If it sends you an error, tell me what the error message says? in which line did it stop? if the macro copied something?

 

[Kpersen]

I had to change the VBA slightly as it first copied the head from the master list and then stopped after the first location was copied over.

After I changed it as per below it ran well until it stopped at a location code defined in the "Weekly Contact Count" but did not have any data in "Master List" it stops and give error because no data is found.

How do I ensure that it just skips to the next location if there is an error on one?

 

[Kpersen]

This worked perfectly. I cannot thank you enough Dante.

 

[DanteAmor]

I had to change the VBA slightly as it first copied the head from the master list and then stopped after the first location was copied over.

After I changed it as per below it ran well until it stopped at a location code defined in the "Weekly Contact Count" but did not have any data in "Master List" it stops and give error because no data is found.

How do I ensure that it just skips to the next location if there is an error on one?

I really don't know how your data is, that causes me confusion
My tests work well.


Add
On Error Resume Next
At the beginning of the code

 

[Kpersen]

This works absolutely perfect. Thank you very, very much for your help. I truly admire your skills especially since you have had to advise me "working in the blind" without being able to see the file.

Thanks again

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.