none
Copy CELL's in Excel only if colored RRS feed

  • Question

  • Hi

    I want to copy a CELL from one excel sheet A (file) to another Excel sheet B in another file but only if the CELL is colored (any color). 

    If the CELL is colored, I want to copy BOTH the color and the text in the cell. If possible also any notes on the cell.

    My sheet A is with approx. 200 columns and 200 rows and I want some automatic that searches the sheet for colored CELL's and copy them to another similar sheet B. All CELL's in sheet A without a color shall not be copied even though it may have some text.

    So if CELL A1, C1, D1 in sheet A is colored (and maybe have som text in it), it shall be copied to CELL A1, C1, D1 in sheet B.

    If CELL B1 in sheet A is NOT colored but have som text in it, it shall NOT be copied to CELL B1 in sheet B.

    Can anyone please help





    Wednesday, March 6, 2019 10:26 PM

All replies

  • Hi,

    Based on your description, your requirement can be achieved by using macro code, I will move this thread to Excel for Developer forum:

    https://social.msdn.microsoft.com/Forums/en-US/home?forum=exceldev

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding.

    Regards,

    Emi Zhang


    Please remember to mark the replies as answers if they helped. If you have feedback for TechNet Subscriber Support, contact tnsf@microsoft.com.

    Click here to learn more. Visit the dedicated forum to share, explore and talk to experts about Microsoft Office 2019.

    Thursday, March 7, 2019 5:47 AM
  • No Thank YOU.... My mistake. New in the forum. I will follow your link.

    Thanks.

    Thursday, March 7, 2019 12:14 PM
  • Hello, here is a solution.It uses free Spire.Xls. Hope it can help you.

     Workbook workbook = new Workbook();
                workbook.LoadFromFile(@"..\..\test.xlsx");
                Worksheet worksheetA = workbook.Worksheets["SheetA"];
                Worksheet worksheetB  = workbook.Worksheets["SheetB"];
    
                foreach(CellRange range in worksheetA.Cells)
                {
                    if (!range.Style.Color.IsEmpty)
                    {
                        if (range.Style.Font.Color.Name!="WindowText")
                        {
    
                            worksheetB.Copy(range, worksheetB.Range[range.Row,range.Column],true);
                        }
                    }
                }
    
                string result = "result.xlsx";
                workbook.SaveToFile(result,ExcelVersion.Version2013);

    Sincerely

    Friday, March 8, 2019 4:11 AM
  • Assuming you have two files called "FileA.xlsm" and FileB.xlsx and the FileA has a sheet called "A" and FileB has a sheet called "B". And you want to copy the desired cells from Sheet "A" to Sheet "B", please do the following...

    Save both the files "FileA.xlsm" and FileB.xlsx" in the SAME FOLDER and place the following macro on a Standard Module like Module1 in the file "FileA.xlsm".

    Please pay attention to the remarks added in the code so that you can tweak it as per your need.

    Sub CopyCells()
    Dim wbDest As Workbook
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim strFilePath As String, strDestFileName As String
    Dim rngSource As Range, aCell As Range
    
    Application.ScreenUpdating = False
    
    'Assuming the name of the Source Sheet is "A", change it as per your requirement
    Set wsSource = ThisWorkbook.Worksheets("A")
    
    'Setting the source range on source sheet
    Set rngSource = wsSource.UsedRange
    
    'Assuming both the File A and File B are saved in the same folder
    strFilePath = ThisWorkbook.Path & "\"
    
    'Name of the destination Workbook. Assuming it is "FileB.xlsx". Change it as per your need
    strDestFileName = "FileB.xlsx"
    
    'Check if the Destination file is already opened
    On Error Resume Next
    Set wbDest = Workbooks(strDestFileName)
    On Error GoTo 0
    
    'If destination file is not opened, open it
    If wbDest Is Nothing Then
        Set wbDest = Workbooks.Open(strFilePath & strDestFileName)
    End If
    'Setting the destination Sheet. Assuming the name of the destination sheet is "B". Change it as per your need
    Set wsDest = wbDest.Worksheets("B")
    
    'Checking each cell in the source range and if the cell is colored, copy it to the destination sheet
    For Each aCell In rngSource
        If aCell.Interior.ColorIndex <> xlNone Then
            aCell.Copy wsDest.Range(aCell.Address)
        End If
    Next aCell
    
    'Close the destination workbook
    wbDest.Close True
    
    Application.ScreenUpdating = True
    End Sub


    Subodh Tiwari (Neeraj) sktneer

    Friday, March 8, 2019 10:06 AM
  • Hi. Thanks a lot. I'm not quiet sure to use free spire.xls and my sheet is beyond 200 rows. So I will try the other suggestion provided for me.

    Thank you

    Saturday, March 9, 2019 8:49 AM
  • OMG.. (as my daughter would say :-) ).  This is nearly perfect and absolutely fantastic.

    The code you provided for me do the job copying the colored CELL's with or without text and leave the uncolored CELL's (with or without text), and that is perfect.

    I have the need that if a CELL is un-collered ind SHEET A it also must un-color in SHEET B. SHEET B must be a completely copy 1:1 af SHEET A but only with focus on the colored CELLE's. So I guess the VBA must clear SHEET B and refill it... or ????



    Saturday, March 9, 2019 8:55 AM
  • You're welcome Kim. Glad it worked as desired. :)

    You can add one line wsDest.Cells.Clear after setting the destination sheet to clear the cells on Destination Sheet before copying the colored cells.

    'Setting the destination Sheet. Assuming the name of the destination sheet is "B". Change it as per your need
    Set wsDest = wbDest.Worksheets("B")
    wsDest.Cells.Clear


    Subodh Tiwari (Neeraj) sktneer




    Saturday, March 9, 2019 9:30 AM
  • You're welcome Kim. Glad it worked as desired. :)

    You can add one line wsDest.Cells.Clear after setting the destination sheet to clear the cells on Destination Sheet before copying the colored cells.

    'Setting the destination Sheet. Assuming the name of the destination sheet is "B". Change it as per your need
    Set wsDest = wbDest.Worksheets("B")
    wsDest.Cells.Clear


    Subodh Tiwari (Neeraj) sktneer




    Hi Subodh

    You are the King!!! The functions seems to be exactly as I wanted. Now I will try to use it in my relative large SHEET (about 300 rows and 100 Columns).

    How do I give you point? I am new in this forum? So far you earned a lot :-)

    Kim.

    Saturday, March 9, 2019 11:20 AM
  • Thanks for the kind words Kim! I appreciate it. :)

    I am not sure about how can you mark an answer as a Solution as I am new to this forum as well. Maybe you can find an option to accept the solution at the bottom of my answer, left to my username.

    If still you are not able to figure it out, please ask for the moderator's help. :)


    Subodh Tiwari (Neeraj) sktneer

    Saturday, March 9, 2019 11:48 AM
  • Thanks for the kind words Kim! I appreciate it. :)

    I am not sure about how can you mark an answer as a Solution as I am new to this forum as well. Maybe you can find an option to accept the solution at the bottom of my answer, left to my username.

    If still you are not able to figure it out, please ask for the moderator's help. :)


    Subodh Tiwari (Neeraj) sktneer

    May I ask you for one more tip? If I only want some ROWS to be cleared and set again (I know I did not made that clear from the start)…. If only ex. row 7 to 11 and 17 to 21 and 27 to 31 and so on needs to be checked for colored or not colored.. All other rows must be untouched.
    Can I set rngSource to a set of ROWS?

    I will ask the moderator. I am not sure my "vote" is the same at giving you point. 

    It is for me really a huge help for me to meet proff. like you and I really want to give you some credit :-)


    Sunday, March 10, 2019 9:01 AM
  • Thanks for the kind words Kim! I appreciate it. :)

    I am not sure about how can you mark an answer as a Solution as I am new to this forum as well. Maybe you can find an option to accept the solution at the bottom of my answer, left to my username.

    If still you are not able to figure it out, please ask for the moderator's help. :)


    Subodh Tiwari (Neeraj) sktneer

    May I ask you for one more tip? If I only want some ROWS to be cleared and set again (I know I did not made that clear from the start)…. If only ex. row 7 to 11 and 17 to 21 and 27 to 31 and so on needs to be checked for colored or not colored.. All other rows must be untouched.
    Can I set rngSource to a set of ROWS?

    I will ask the moderator. I am not sure my "vote" is the same at giving you point. 

    It is for me really a huge help for me to meet proff. like you and I really want to give you some credit :-)


    Hi Subodh

    Is it possible that you could help me again. I have giving you the maximum points that's possible for me :-)

    Wednesday, March 13, 2019 6:49 AM
  • Sorry Kim I was busy in a paid project so didn't get time to reply.

    Considering your new requirement, please replace the existing code with the following code.

    Sub CopyCells()
    Dim wbDest As Workbook
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim strFilePath As String, strDestFileName As String
    Dim rngSource As Range, aCell As Range
    Dim i As Long, lr As Long
    
    Application.ScreenUpdating = False
    
    'Assuming the name of the Source Sheet is "A", change it as per your requirement
    Set wsSource = ThisWorkbook.Worksheets("A")
    
    lr = wsSource.UsedRange.Rows.Count
    
    'Assuming both the File A and File B are saved in the same folder
    strFilePath = ThisWorkbook.Path & "\"
    
    'Name of the destination Workbook. Assuming it is "FileB.xlsx". Change it as per your need
    strDestFileName = "FileB.xlsx"
    
    'Check if the Destination file is already opened
    On Error Resume Next
    Set wbDest = Workbooks(strDestFileName)
    On Error GoTo 0
    
    'If destination file is not opened, open it
    If wbDest Is Nothing Then
        Set wbDest = Workbooks.Open(strFilePath & strDestFileName)
    End If
    'Setting the destination Sheet. Assuming the name of the destination sheet is "B". Change it as per your need
    Set wsDest = wbDest.Worksheets("B")
    wsDest.Cells.Clear
    
    'Checking each cell in the source range and if the cell is colored, copy it to the destination sheet
    
    For i = 7 To lr Step 10
        Set rngSource = Intersect(wsSource.Rows(i), wsSource.UsedRange).Resize(5)
        For Each aCell In rngSource
            If aCell.Interior.ColorIndex <> xlNone Then
                aCell.Copy wsDest.Range(aCell.Address)
            End If
        Next aCell
        Set rngSource = Nothing
    Next i
    
    'Close the destination workbook
    wbDest.Close True
    
    Application.ScreenUpdating = True
    End Sub


    Subodh Tiwari (Neeraj) sktneer

    Wednesday, March 13, 2019 5:32 PM
  • Sorry Kim I was busy in a paid project so didn't get time to reply.

    Considering your new requirement, please replace the existing code with the following code.

    Sub CopyCells()
    Dim wbDest As Workbook
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim strFilePath As String, strDestFileName As String
    Dim rngSource As Range, aCell As Range
    Dim i As Long, lr As Long
    
    Application.ScreenUpdating = False
    
    'Assuming the name of the Source Sheet is "A", change it as per your requirement
    Set wsSource = ThisWorkbook.Worksheets("A")
    
    lr = wsSource.UsedRange.Rows.Count
    
    'Assuming both the File A and File B are saved in the same folder
    strFilePath = ThisWorkbook.Path & "\"
    
    'Name of the destination Workbook. Assuming it is "FileB.xlsx". Change it as per your need
    strDestFileName = "FileB.xlsx"
    
    'Check if the Destination file is already opened
    On Error Resume Next
    Set wbDest = Workbooks(strDestFileName)
    On Error GoTo 0
    
    'If destination file is not opened, open it
    If wbDest Is Nothing Then
        Set wbDest = Workbooks.Open(strFilePath & strDestFileName)
    End If
    'Setting the destination Sheet. Assuming the name of the destination sheet is "B". Change it as per your need
    Set wsDest = wbDest.Worksheets("B")
    wsDest.Cells.Clear
    
    'Checking each cell in the source range and if the cell is colored, copy it to the destination sheet
    
    For i = 7 To lr Step 10
        Set rngSource = Intersect(wsSource.Rows(i), wsSource.UsedRange).Resize(5)
        For Each aCell In rngSource
            If aCell.Interior.ColorIndex <> xlNone Then
                aCell.Copy wsDest.Range(aCell.Address)
            End If
        Next aCell
        Set rngSource = Nothing
    Next i
    
    'Close the destination workbook
    wbDest.Close True
    
    Application.ScreenUpdating = True
    End Sub


    Subodh Tiwari (Neeraj) sktneer

    Hi Subodh an thank you.

    The functions are perfect, but unfortunately i'm not having succes in my original worksheed. I have about 200 rows and it takes about ten minutes to run the macro.

    • Row 1, 2, and 3 and Column A, B and C are PERMANENT ind Worksheet A and must always be displayed in Worksheet B.
    • Row 4, 5, 6, 7, 8 and 9 is changeable for the user. If a Cell is Colored (with or without any text) It shall be copied to another Worksheet in another file. If the same cell is uncolored again (may still contain text), it shall be cleared completely in the other file/worksheet
    • Row 10, 11, 12 and 13 are permanent and shall always be copied to the other file/worksheet

    Repeating….

    • Row 14, 15, 16, 17, 18 and 19 is changeable for the user. If a Cell is Colored (with or without any text) It shall be copied to another Worksheet in another file. If the same cell is uncolored again (may still contain text), it shall be cleared completely in the other file/worksheet
    • Row 20, 21, 22 and 23 are permanent and shall always be copied to the other file/worksheet

    And so on up to 20 times :-)

    And as said…. Your formula does the trick copying but the line [ wsDest.Cells.Clear ] is to hard on the destination worksheet - cleares to much :-),  and it takes about 10 minutes to run through all cells :-(.

    Is there by any chance a possibility to show you my worksheet? Or is it to ask for much? I completely understand!!


    Friday, March 15, 2019 12:48 PM