Link to home
Start Free TrialLog in
Avatar of fb1990
fb1990

asked on

Copy Specific Records

Hello Experts,


I have a VBA that copies data from one Excel tab to another.  But, I need certain records from being copied.  If the value in column 16 in the source file equals "A0162", I want to copy all the data to another tab.  My source data is the CUST tab.  I want to move the data into CUST2 Tab.

Avatar of fb1990
fb1990

ASKER

Here is what I currently have:


Sub copyData()

Dim srcFile, destFile, destMove, UR As Range

srcFile = Split("A B C D E F G G L I J O P Q R S T U T V W X Y Z AA AC AD")

destFile = Split("A B C D E F G H I J K L M N O P Q R S T U V W X Y Z AA")


Dim i As Long

    With Sheets("CUST")

        Set UR = Range(.Cells(1, 1), .Cells.SpecialCells(xlCellTypeLastCell))

        With Sheets("CUST2").Cells.Resize(UR.Rows.Count)

            For i = 0 To UBound(srcFile)

                destMove = UR.Columns(srcFile(i)).Cells

                .Columns(destFile(i)) = destMove

            Next

            .Columns("A").NumberFormat = "mm/dd/yyyy"

        End With

    End With

End Sub


Avatar of Greg Besso

You can modify your existing VBA code to check the value in column 16 before copying the data. Here's a sample VBA code that will do that: 


Sub CopyData()


    Dim wsSource As Worksheet

    Dim wsDestination As Worksheet

    Dim srcLastRow As Long

    Dim destLastRow As Long

    Dim i As Long


    ' Set the source and destination worksheets

    Set wsSource = ThisWorkbook.Worksheets("CUST")

    Set wsDestination = ThisWorkbook.Worksheets("CUST2")


    ' Find the last row in the source worksheet

    srcLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row


    ' Loop through all the rows in the source worksheet

    For i = 1 To srcLastRow

        ' Check if the value in column 16 is "A0162"

        If wsSource.Cells(i, 16).Value = "A0162" Then

            ' Find the next empty row in the destination worksheet

            destLastRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1


            ' Copy the entire row from the source to the destination worksheet

            wsSource.Rows(i).EntireRow.Copy wsDestination.Rows(destLastRow)

        End If

    Next i


    ' Clear the clipboard and release the memory

    Application.CutCopyMode = False


End Sub





This code will loop through all the rows in the "CUST" tab and check if the value in column 16 equals "A0162". If it does, it will copy the entire row to the "CUST2" tab. Please modify it as needed to fit your specific workbook structure.


Avatar of fb1990

ASKER

@Greg Besso 

Thank you so much for your assistance.  Can you help modify your code to copy specific columns?  I am getting specific columns from the source data to specific columns in the destination tab.  Similar to what i have here:


srcFile = Split("A B C D E F G G L I J O P Q R S T U T V W X Y Z AA AC AD")

destFile = Split("A B C D E F G H I J K L M N O P Q R S T U V W X Y Z AA")


Avatar of fb1990

ASKER

I tried the solution provided, it did not return any record in the destination tab

Certainly! You can modify the code to copy specific columns using the arrays you provided. Here's the modified code: 



Sub CopyData()


    Dim wsSource As Worksheet

    Dim wsDestination As Worksheet

    Dim srcLastRow As Long

    Dim destLastRow As Long

    Dim i As Long, j As Long

    Dim srcFile As Variant, destFile As Variant


    ' Set the source and destination worksheets

    Set wsSource = ThisWorkbook.Worksheets("CUST")

    Set wsDestination = ThisWorkbook.Worksheets("CUST2")


    ' Define the source and destination columns

    srcFile = Split("A B C D E F G G L I J O P Q R S T U T V W X Y Z AA AC AD")

    destFile = Split("A B C D E F G H I J K L M N O P Q R S T U V W X Y Z AA")


    ' Find the last row in the source worksheet

    srcLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row


    ' Loop through all the rows in the source worksheet

    For i = 1 To srcLastRow

        ' Check if the value in column 16 is "A0162"

        If wsSource.Cells(i, 16).Value = "A0162" Then

            ' Find the next empty row in the destination worksheet

            destLastRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1


            ' Loop through the columns in the srcFile and destFile arrays

            For j = LBound(srcFile) To UBound(srcFile)

                ' Copy the specific cell value from the source to the destination worksheet

                wsDestination.Cells(destLastRow, destFile(j)).Value = wsSource.Cells(i, srcFile(j)).Value

            Next j

        End If

    Next i


End Sub




This code will loop through all the rows in the "CUST" tab and check if the value in column 16 equals "A0162". If it does, it will copy the specific columns from the source row to the specific columns in the destination row using the srcFile and destFile arrays you provided.


Would you consider using a simple manual method? Or recording a macro using that simple manual method?


  1. Select your data including header labels
  2. Use the Data...Filter ribbon item
  3. Click the AutoFilter arrow on column P and choose A01262 as the value to filter
  4. Copy the visible rows and paste in the other tab
Avatar of fb1990

ASKER


@Greg Besso I ran the code and it is not producing any results in the destination tab. I changed .Value to .Text.  Still no data. My original code copies the data but, I need to limit the data to specific group.


@byundt:  Thanks, I wanted a Macro.  Too Much data.  Manually doing it is hugging resource on my PC

I realize you wanted a macro. But it is easy to record one provided the method works. And such a macro will run many times faster than the row at a time copy and paste that your current code is performing.

Similar to Byundt, you can also use the Advanced Filter. This method you create a small table with the filter criteria using the same column header(s) as the filter column and then list below the required values. With Advanced Filter you can specify a destination for the filtered data and can specify which columns and in which order they are wanted based on the column headers of the source data.


The Advanced Filter can be automated into a VBA routine including options to determine whether you want filtered data overwritten in the destination or appended to previous filter results.

Too Much data.  Manually doing it is hugging resource on my PC

That comment tells me that you aren't using 64-bit Microsoft 365 subscription version of Excel. The old default installation of Excel is 32-bit. In Excel 2010 and earlier, it is limited to 2 GB of memory for the application, add-ins and open workbooks. Doesn't matter how much RAM you had on your computer, Excel was only ever going to use 2 GB. That's because 32-bits handles integers between plus or minus 2^31 or 2,147,483,648.


Excel 2013 and later are large address aware. That means they also use the negative numbers as addresses to handle up to 4 GB of addressable memory. It's still shared, however, between the Excel app, add-ins and open workbooks.


The real fix to the memory problem is to uninstall 32-bit Office and reinstall it as a 64-bit application. You may then address terabytes of memory--more than you or I could afford for the next decade or two. You won't lose settings or email as a result of this uninstall/reinstall process.


I also suggested using Microsoft 365 because Microsoft has made large improvements in things like speed of lookup formulas (VLOOKUP, INDEX & MATCH, XLOOKUP), making them over a thousand times faster on large lookup tables. Microsoft has also addressed the speed of filtering and sorting. The resulting application has fewer hangs, freezes and crashes of any version of Excel. 

ASKER CERTIFIED SOLUTION
Avatar of byundt
byundt
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of fb1990

ASKER

Much appreciation for everyone who contributed a solution. Thank you!