Excel: transfer color filling from one document to another

Question

I have two documents having some same rows (and some rows are different). In Document1 I work with file and color some rows (or cells).
How could I switch to Documnent2 and color the rows (cells) I colored in Document1 in the same way? Is there any parser available?

For example:
Doc1:

1   a 1 2 3 4  # is full colored
2   b 1 3 6 7
3   c 1 1 1 2  # is full colored

Doc2:

1   c 1 1 1 2
2   a 1 2 3 4
3   d 5 6 8 1
4   b 1 3 6 7

I need to color rows with indexes 1 and 2, because they are the same as in Doc1, and are full colored.

If I use Format Painter, I get first and third rows colored, but it's wrong for me.

I see the solution like formula, that checks by row letter, is it colored, or not, and colors the row letter in other document. But I don't know how to code it :(

P.S. I also have troubles with getting cell colours - GET.CELL(63,INDIRECT("rc",FALSE)) doesn't work for me, there is no GET.CELL() function found.

P.P.S. Both documents are too big (more than 1.000.000 rows), so I think the best solution would be formula (macroses often are too slow).

Answer 1

The speed of the code depends on how many cells are coloured

You'd have to adapt it to fit your needs

Option Explicit
' Credits: https://stackoverflow.com/a/30067221/1521579
' Credits: https://www.mrexcel.com/board/threads/vba-to-compare-rows-in-two-different-sheets-and-if-they-match-highlight-in-red.1067232/
Sub CheckRows()

    Dim StartTime As Double
    Dim SecondsElapsed As Double
    
    StartTime = Timer
    
    Dim sourceSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
    
    Dim targetFile As Workbook
    Set targetFile = ThisWorkbook 'Workbooks("File2")
    
    Dim targetSheet
    Set targetSheet = targetFile.Worksheets("Sheet2")
    
    Dim sourceLastRow As Long
    sourceLastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    
    Dim sourceRange As Range
    Set sourceRange = sourceSheet.Range("A1:E" & sourceLastRow)
    
    Dim targetLastRow As Long
    targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
    
    Dim targetRange As Range
    Set targetRange = targetSheet.Range("A1:E" & targetLastRow)
    
    Dim tempDict As Object
    Set tempDict = CreateObject("scripting.dictionary")
    
    Dim cellsString As String
    
    ' Add first range to dict
    Dim sourceCell As Range
    Dim sourceCounter As Long
    For Each sourceCell In sourceRange.Columns(1).Cells
        sourceCounter = sourceCounter + 1
        ' Check if cell has color
        If sourceCell.Interior.Color <> 16777215 Then
            cellsString = Join(Application.Index(sourceCell.Resize(, sourceRange.Columns.Count).Value, 1, 0), "|")
            tempDict.item(cellsString) = sourceCell.Interior.Color
        End If
    Next sourceCell
    
    ' Check in target range
    Dim targetCell As Range
    Dim sourceColor As String
    For Each targetCell In targetRange.Columns(1).Cells
        cellsString = Join(Application.Index(targetCell.Resize(, targetRange.Columns.Count).Value, 1, 0), "|")
        If tempDict.exists(cellsString) Then
            sourceColor = tempDict.item(cellsString)
            targetCell.Resize(, targetRange.Columns.Count).Interior.Color = sourceColor
        End If
    Next targetCell
    
    SecondsElapsed = Round(Timer - StartTime, 2)
    Debug.Print SecondsElapsed, "Source rows:" & sourceLastRow, "Target rows: " & targetLastRow
End Sub

' Credits: https://stackoverflow.com/a/9029155/1521579
Function GetKey(Dic As Object, strItem As String) As String
    Dim key As Variant
    For Each key In Dic.Keys
        If Dic.item(key) = strItem Then
            GetKey = CStr(key)
            Exit Function
        End If
    Next
End Function

Answer 2

If you're comfortable with adding few helper columns in both of your documents, you can use the following solution.

Note that the below solution demonstrates the data being in 2 sheets within the same document. You can easily apply the same logic with different documents.

Assumptions:

• Number of columns remain the same in both documents
• you're looking for an exact match

Solution:

You can download the sample excel document with the below solution from the following link.

1. Create a helper column(G) in both the documents which is a concatenation of all the existing columns using =TEXTJOIN(", ",FALSE,B2:E2) like below:

       A B C D E F -----G-------
   1   a 1 2 3 4   a, 1, 2, 3, 4
   2   b 1 3 6 7   b, 1, 3, 6, 7
   3   c 1 1 1 2   c, 1, 1, 1, 2
   

2. In document2 create another column(H) which will identify the corresponding row number from document1 using =IFERROR(MATCH(G2,'document 1'!$G$1:$G$5,0),0) formula. Like below
   Note: 0 if no match is found

3. Add a formula in any cell which will calculate the total number of rows that should be checked in document2

       A B C D E F -------G-----    H
   1   c 1 1 1 2   c, 1, 1, 1, 2    3
   2   a 1 2 3 4   a, 1, 2, 3, 4    1
   3   d 5 6 8 1   d, 5, 6, 8, 1    0
   4   b 1 3 6 7   b, 1, 3, 6, 7    2
   5
   6               =COUNTA(G1:G4)
   

4. Once these columns are added, you can use these columns to loop through the rows in document2 and see if there is match in document1 and copy formatting if there is a match using the code below:

   Public Sub Copy_Formatting()
   
   'Stack Overflow question: https://stackoverflow.com/questions/65194893/excel-transfer-color-filling-from-one-document-to-another
   
   Dim Curr_Range As Range, Match_Value As Integer, Rows_to_loop As Integer
   
   Rows_to_loop = Sheet2.Range("G6").Value
   
   For i = 1 To Rows_to_loop
       Set Curr_Range = Sheet2.Range("B1:E1").Offset(i, 0)
       Match_Value = Sheet2.Range("H1").Offset(i).Value
       If Match_Value > 0 Then
           Sheet1.Range("B1:E1").Offset(Match_Value - 1).Copy
   
           With Curr_Range.Interior
               .Pattern = xlNone
               .TintAndShade = 0
               .PatternTintAndShade = 0
           End With
   
           Curr_Range.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
               SkipBlanks:=False, Transpose:=False
   
           Application.CutCopyMode = False
       End If
   
   Next i
   
   End Sub
   

Checkout the following GIF that shows the result:

Answer 3

two options:

• Use the format painter (mark the cells for which you want to copy formatting, click the format painter icon, switch to Document 2, select the cells where you want to paste formatting)

• Use "paste formatting" using Ctrl-C -> go to Document 2 -> Paste Special -> Formats.

Answer 4

If I understand your question correctly: you want to copy only the formatting from excel file 2 to excel file 1 while retaining the information.

1. copy everything from file 2.
2. paste it in file 1 and press ctrl. Pick the bottom-left option to only retain formatting.

If you're using conditional formatting you can also just make a backup of file 2 and paste file 1 into file 2 while only retaining text (one of the ctrl paste options).