Loop through column data and delete or copy based on value given

[ricky10ss]

Hello,

First time posting on there, thanks in advance for any help provided. I am looking to loop through 300,000 rows of data that has a column called "Zone". There are 10 zones which are 2100, 2200, 4600, 9100, 9300, 9400, 9500,etc. I would like something to help automate me manually deleted rows. Right now someone gives me a count for each zone and I would like to input 500 for zone 2100, 1000 for 2200, 1500 for 4600, etc. and have a final count based on the provided list of zones. It is not really important which records are removed or copied. Just need the exact count for each zone.

I am using Office 2016 on Windows 8.

Thanks
Rick

[mdmackillop]

I can't follow your requirements. Can you post a sample workbook with further clarification or before/after scenario?
Go Advanced / Manage attachments.

[ricky10ss]

Sorry about that. Attached SampleData.xlsx is original data. Sample-Count.xlsx would be approved counts for each zone. SampleData_Final.xlsx would be the final list with the approved counts by zone.

[mdmackillop]

The count of all in your data exceed requirements so I guess the "surplus" are to be deleted. If there is a "lack" then sufficient records are to be copied to make up the required number?

[mdmackillop]

Best guess

Sub Test()
    Dim r As Range
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet


    Application.ScreenUpdating = False
    Set ws1 = Sheets("U4340598")
    Set ws2 = Sheets("Count")
    With ws2
        Set r = Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
    End With
    Set Rng = ws1.Columns(12).SpecialCells(2)
    For Each cel In r
        x = ws2.Cells.Find(cel).Offset(, 1).Value
        i = Rng.Find(cel, after:=Rng(1), searchdirection:=xlNext).Row
        j = Rng.Find(cel, after:=Rng(1), searchdirection:=xlPrevious).Row
        If (j - i) > x Then
            ws1.Cells(i, 12).Offset(x).Resize(j - i - x + 1).EntireRow.Delete
        ElseIf (j - i + 1) < x Then
            ws1.Cells(j + 1, 12).Resize(x - (j - i) - 1).EntireRow.Insert
            ws1.Cells(i, 12).Resize(x - (j - i) - 1).EntireRow.Copy ws1.Cells(j + 1, 1)
        End If
    Application.CutCopyMode = False
    Next cel
    Application.ScreenUpdating = True
End Sub

[ricky10ss]

Looks like this will work for me, Thanks!! One last question what would I need to edit in the code if I have more Zones like the attached file?

[mdmackillop]

Nothing.

[ricky10ss]

Sorry to bug. I am getting a run-time error '91' and when I debug I it is highlighting " i = Rng.Find(cel, after:=Rng(1), searchdirection:=xlNext).Row" in the code. I went through and added all zones which there are 31 zones and tested setting the count to 500 each.

[mdmackillop]

A couple of things.
Does the zone exist in the data? I assumed it must, given the premise of your question. If not, should the Count just be ignored?
I did not allow for copying say 10 rows to 500. My code allows for one copy to increase the number. Is this required?

[ricky10ss]

Yes the zones do exist in the data. See example below. The final list would be 500 of each zone for a total of 15,500. This was just a simple test of course the amounts will vary but the count will never be more then the existing records.

Zone	Count	Exist
2100 Pensacola	500	6183
2103 Jacksonville	500	4407
2103 Tallahassee	500	1902
2301 North Lams	500	8081
2302 South Lams	500	5295
3100 Satellitte Texas	500	573
3100-Satelitte Texas	500	3587
3200 Birmingham	500	4042
4200 North Houston	500	14382
4400 Se Houston	500	16392
4600 Sw Houston	500	17022
5200 West San Antonio	500	7510
5400 East San Antonio	500	10449
5600 Austin	500	17168
7100 Arizona	500	21187
7300 Albuquerque	500	5498
7300 El Paso	500	5275
7300 Las Cruces	500	1415
7800 West Texas	500	9704
8200 Rgv	500	6827
8400 Corpus Christi	500	4823
9100 Fort Worth	500	8657
9200 Se Dallas	500	7864
9300 Central Dfw	500	18407
9400 Northwest Arkansas	500	1564
9400 Oklahoma City	500	7609
9400 Tulsa	500	6556
9500 Ne Dallas	500	11998
Franchisee Unit Listing	500	8433
Franchisee Unit Listing 2017 Q2	500	9418
Franchisee Unit Listing 2017 Q3	500	9274

[ricky10ss]

Hi mdmackillop,

The code is working but once I add more zones I get the run-time error 91. Here is a link to the file I have. You think you can look at it?

https://files.fm/u/w4r55qww

[mdmackillop]

The error is caused by A8 3100-Satelitte Texas which dos not exist on your data sheet, It can be handled in the code but it would be better if your Count page was populated to exclude false data.

[ricky10ss]

Thanks that did it!