dimanche 1 novembre 2020

Vba to search through column c for matching data and cut/paste all adjacent rows

This is my code to search for matching data in column C, then cut and paste all adjacent rows to different tab. Delete blank cells and repeat. The code works, but stops working once there are 500+ rows to search through. No error messages, it just want loop through all of the data.

Sub BeginPullingPins()

Dim wstSource As Worksheet, _

    wstDestination As Worksheet

Dim rngCell As Range, _

    rngMyData As Range

Dim lngMyRow As Long



Set wstSource = Worksheets("RawData")

Set wstDestination = Worksheets("DataCleaning")

Set rngMyData = wstSource.Range("A1:J" & Range("J" & Rows.Count).End(xlUp).Row)





With Destination



lastrow = Cells(Rows.Count, "C").End(xlUp).Row

N = 1



For i = 1 To lastrow

    If i = lastrow Then

        If Range("C" & i).Value <> Range("C" & i - 1).Value Then

            Range("C" & N & ":CJ" & i).Select

            N = i + 1



            With Worksheets("RawData")

            cpy.Cut Destination:=.Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0)

            End With

            End If



    Else





        If Range("C" & i).Value <> Range("C" & i + 1).Value Then

            Range("C" & N & ":CJ" & i).EntireRow.Cut

            N = i + 1





            Sheets("DataCleaning").Select

            Range("A1").Select

            ActiveSheet.Paste



            End If





        End If



    Next i





Sheets("RawData").Select

Dim lRow As Long

Dim iCntr As Long

lRow = 40

For iCntr = lRow To 1 Step -1

    If Trim(Cells(iCntr, 1)) = “” Then

        Rows(iCntr).Delete

        Else

    End If

Next





Sheets("DataCleaning").Select

End With

End Sub

Aucun commentaire:

Enregistrer un commentaire