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).
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
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.
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
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
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)
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:
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.
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.
copy everything from file 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).
I have following table in an Excel file:
customer ID sell attribute1 attribute2 attribute3 …… attribute N
Customer1 sell1 1 0 1 1
Customer1 sell2 0 0 0 0
Customer1 sell3 1 0 1 1
Customer2 sell4 0 0 0 1
Customer2 sell5 1 0 1 0
Customer3 sell6 1 0 0 0
…… ……
I need an Excel VBA function to remove redundant customers rows and produce only one row for each customer represent the all columns values for that customer ... ( max value for each column produce only maximum values in that column ), column sell its not consider in the final result.
The result as follows:
customer ID attribute1 attribute2 attribute3 …… attribute N
Customer1 1 0 1 1
Customer2 1 0 1 1
Customer3 1 0 0 0
etc....
VBA is not required for this. Select all your data and DATA > Outline - Subtotal:
At each change in: customer ID
Use function: Max
Add subtotals to: check each of the attributes (only)
Check Replace current subtotals and Summary below data
OK
Copy and Paste Special..., Values over the top. Filter to select for ColumnA, Text Filters, Contains..., Max, OK, select visible data (excluding last row if not wanted), copy and paste where required. Delete ColumnB.
Try this simple little procedure
Sub MergeData()
Dim lastrow As Long
Dim lastcol As Long
Dim i As Long, ii As Long
Application.ScreenUpdating = False
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For i = lastrow To 2 Step -1
If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then
For ii = 3 To lastcol
.Cells(i - 1, ii).Value = -(.Cells(i - 1, ii).Value > 0 OR .Cells(i, ii).Value > 0)
Next ii
.Rows(i).Delete
End If
Next i
.Columns(2).Delete
End With
Application.ScreenUpdating = True
End Sub
What i want to do is to loop through the rows of a table, And checking each row in a column for duplicates.
For example I will start with cell A2, say it has a text value of "CAP". I want to compare that value "CAP" with all of the other rows in that Column.
If it finds a Duplicate i want it to put in the Column dupe "Dupe1" so both records have the same dupe number.
Then it moves to A3 and checks that value with all of the other rows in that column. so on so on.
If more dupes are found then they are names "Dupe2", "Dupe3" etc...
I am struggling to figure out how to achieve this?
For Example, you have two columns:
Column A | Dupe
1
2
3
4
4
5
4
Sub Button1_Click()
n = ThisWorkbook.Worksheets(1).Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
Dim Counter As Integer
Counter = 1
Duplicate = 0
For i = 2 To n
If Len(Trim(Worksheets(1).Cells(i, 2))) = 0 Then
For j = i + 1 To n
If Worksheets(1).Cells(i, 1) = Worksheets(1).Cells(j, 1) Then
Worksheets(1).Cells(i, 2) = "Dupe" + CStr(Counter)
Worksheets(1).Cells(j, 2) = "Dupe" + CStr(Counter)
Duplicate = 1
End If
Next j
End If
If Duplicate = 1 Then
Counter = Counter + 1
Duplicate = 0
End If
Next i
End Sub
I want to replace the values in column 1 of sheet 2(which is same as col 2 of sheet 1) by the corresponding values of column 1 of sheet 1.
SHEET 1 SHEET 2 RESULT SET
Col 1 Col 2 Col 1 Col 1
Row 1 A 1 Row 1 1 Row 1 A
Row 2 B 2 Row 2 2 Row 2 B
Row 3 C 3 Row 3 3 Row 3 C
Row 4 D 4 Row 4 4 Row 4 D
Row 5 E 5 Row 5 5 Row 5 E
Hope my question is not absurd
Thanks in Advance``
I used the macrorecorder and then tweaked the code a little bit. This will adapt if you ever have a different number of rows. Hope this helps! Let me know if it's not quite what you meant.
Sub Macro1()
Dim Count As Double
Count = 1
While Range("A" & CStr(Count)) <> ""
Count = Count + 1
Wend
Sheet1.Range("A1:A" & CStr(Count - 1)).Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
I need some help converting three colums into a matrix using excel macro.
Here is an example:
From this:
A A 0
A B 23
A C 3
B A 7
B B 56
B C 33
C A 31
C B 6
C C 5
to this:
A B C
A 0 23 3
B 7 56 33
C 31 6 5
Hope you can help me.
Thanks
Not quite sure what exactly you are meaning by matrix. For the code below I assumed you were looking for a way to read the data in the first two columns as Row and Column data of the output table. Assume the input data is in the Columns 1 - 3 of "Sheet1"
Sub ConvertTableOfData()
Dim testArray(1 to 3)
Dim chkROW as Integer
Dim chkCOL as Integer
Dim chkVAL as Integer
'// index the Row and Column headers
testArray(1) = "A"
testArray(2) = "B"
testArray(3) = "C"
'// Iterate through every row in the initial dataset
For i = 1 to Worksheets("Sheet1").Cells(1, 1).End(xlDown).Row
With Worksheets("Sheet1")
'// Assign the Output Row and Column values
'// based on the array indices
For j = 1 to UBound(testArray, 1)
If .Cells(i, 1) = testArray(j) Then
chkROW = j
End If
If .Cells(i, 2) = testArray(j) Then
chkCOL = j
End If
Next j
'// store the actual value
chkVAL = .Cells(i, 3)
End With
'// output table (in Sheet2)
With Worksheets("Sheet2")
.Cells(chkROW, chkCOL) = chkVAL
End With
Next i
'// Add headers to Output table
For i = 1 to 3
With Worksheets("Sheet2")
.Cells(i + 1, 1) = testArray(i)
.Cells(i, i + 1) = testArray(i)
End With
Next i
End Sub
You can also perform this without VBA.
Assume your table of data is in the range A1:C9.
Assume the first number (0) in the 3 by 3 grid of data is cell F3, with A, B, C in the row above, and A, B, C in the column to the left.
Enter the formula in cell F3 as
=INDEX($C$1:$C$9,SUMPRODUCT(--($A$1:$A$9=$E3),--($B$1:$B$9=F$2),ROW($A$1:$A$9)))
Copy this formula to all 9 cells in the 3 by 3 grid.
This generalized to any size of data.