Categorised Menu List

Conditionally copy and paste data into new sheet

How it works: 

To copy the row, where the given sheet contains one or more than one tax payers id.

 

The following code is a procedure., so, assign this procedure to a command button and click to execute.

Context: 

We have a huge list of customer data where we have to find, where a particular vendor has no or one or more than one tax payers ids. Copy all the vendors details with one or more than one value into a different sheet.

 

It is always advisable to use status bar to intimate the user that the work is going on.

 

    COPY DATA

    CONDITIONALLY INTO A NEW SHEET

    Sub prcSegregate()

     

    Dim i As Long, j As Long, intTemp As Integer
    Dim lngRowCount As Long
    Dim strSheet As String

     

    Sheets.Add
    ActiveSheet.Name = "SingleTaxPayNo_" & ThisWorkbook.Sheets.Count + 1
    strSheet = ActiveSheet.Name
    Sheets("Main").Range("A1").EntireRow.Copy
    ActiveSheet.Range("A1").PasteSpecial xlPasteAll

     

    Application.ScreenUpdating = False

     

    Sheets("Main").Activate
    Range("A2").Select
    ActiveCell.End(xlDown).Select
    lngRowCount = ActiveCell.Row
    ActiveCell.End(xlUp).Select
    Range("K2").Select

     

    j = 2

     

    For i = 2 To lngRowCount
    Application.StatusBar = "Reading data for row number:" & i
        intTemp = Range("K" & i).Value
        Debug.Print intTemp


        If intTemp = 1 Then
            Range("K" & i).EntireRow.Copy
            Sheets(strSheet).Range("A" & j).PasteSpecial xlPasteValues
            Application.StatusBar = "Copying data for ONE ID ..." & j
            j = j + 1
        Else
            Range("K" & i).EntireRow.Copy
            Sheets(strSheet).Range("A" & j).PasteSpecial xlPasteValues
            Application.StatusBar = "Copying data for more than ONE ID..." & j
            j = j + 1
            i = i + intTemp - 1
        End If
    Next

     

    Application.ScreenUpdating = True
    Application.StatusBar = "Completed Copying data for duplicates..." & j

    End Sub

    Issues you may encounter: While you copy and paste the code from here to code window, replace double quotes in code window again, as these quotes will appear as smart quotes.

     

    Code file in .txt format

    It is always advisable to make best use of status bar.  Application.StatusBar = "some text"

    This will help end user to know that the work is in progress...