Reputation: 51
I am trying to update the Cells from sheet1 to sheet2. In sheet 1 there is column "title" in column A. and in sheet2 clumn "title" is in column B. Target sheet is "sheet2". If any title name in column "A" of sheet2 matches with title of sheet1 then it should update the value for other columns for that title row. And if value is changed for any cell then previous one then it should highlight those cells. and the non matching title rows should copy paste in the end of target sheet. i am working on a code which is updating the values, but dont know how to highlight only those cells which values are changed and also to copy paste the nonmatching title rows in the end.
Sub AG()
Dim sourceWS As Worksheet, targetWS As Worksheet
Dim lastCol As Long, LastRow As Long, srcRow As Range
Dim found1 As Range, found2 As Range, j As Long, Cr1 As String
Dim FRow As Long
Dim i As Integer
Dim k As Integer
Set sourceWS = Worksheets("sheet2")
Set targetWS = Worksheets("sheet3")
LastRow = Sheets("sheet2").Range("A1").SpecialCells(xlCellTypeLastCell).Row
FRow = Sheets("sheet3").Range("A1").SpecialCells(xlCellTypeLastCell).Row
For i = 2 To LastRow
For k = 2 To FRow
If Worksheets("sheet2").Range("A" & i).Value = Worksheets("sheet3").Range("B" & k).Value Then
With sourceWS
lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For j = 1 To lastCol
Cr1 = .Cells(1, j).Value
Set srcRow = .Range("A1", .Cells(1, lastCol))
Set found1 = srcRow.Find(What:=Cr1, LookAt:=xlWhole, MatchCase:=False)
If Not found1 Is Nothing Then
lastCol = targetWS.Cells(1, Columns.Count).End(xlToLeft).Column
Set srcRow = targetWS.Range("A1", targetWS.Cells(1, lastCol))
Set found2 = srcRow.Find(What:=Cr1, LookAt:=xlWhole, MatchCase:=False)
If Not found2 Is Nothing Then
LastRow = .Cells(Rows.Count, found1.Column).End(xlUp).Row
.Range(.Cells(2, found1.Column), .Cells(LastRow, found1.Column)).Copy
found2.Offset(2, 0).PasteSpecial xlPasteAll
rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column
End If
End If
Next j
End With
End If
Next
Next
End Sub
Upvotes: 0
Views: 356
Reputation: 2009
Not so sure if I understand you correctly.
Anyway I guess your situation is something like this :
Sheet2 is the source sheet, Sheet3 is the target sheet.
In sheet3, some data is not the same with the one in sheet2.
So, it need to be corrected then highlight the corrected cell.
For example, xxx01 in sheet2 HDR-09 value is 90, but in sheet3 HDR-09 value is 35.
So, after running the sub, in sheet3 HDR-09 row xxx01 the value will be 90 and highlighted.
Also, in sheet2, there are two titles which not exist in sheet3 column B ---> xxx02 and xxx04. After running the sub, sheet3 will have two addition rows which coming from xxx02 and xxx04 of sheet2.
If that's similar with your situation, then maybe you can have a look the sub below which hopefully can help to get you started :
Sub test()
Dim colCount As Long: Dim src As Worksheet: Dim trg As Worksheet
Dim rg As Range: Dim cell As Range: Dim c As Range
Dim i As Long: Dim hdr As String: Dim v1 As String: Dim v2 As String
Dim col As Range: Dim dest As Range: Dim rgKopi As Range
colCount = 9
Set src = Worksheets("sheet2")
Set trg = Worksheets("sheet3")
Set rg = src.Range("A2", src.Range("A" & Rows.Count).End(xlUp))
For Each cell In rg 'loop to each cell in rg
Set c = trg.Columns(2).Find(cell.Value, lookat:=xlWhole) 'try to find in trg column B if has the looped cell value
If Not c Is Nothing Then 'if found then
For i = 1 To colCount 'loop the cell row offset to i value
hdr = src.Cells(1, cell.Offset(0, i).Column).Value 'get the header name of the looped cell offset i
v1 = cell.Offset(0, i).Value 'get the looped cell offset i value into v1 variable
Set col = trg.Rows(1).Find(hdr, lookat:=xlWhole) 'try to find if the trg header has hdr value
If Not col Is Nothing Then 'if found
Set dest = trg.Cells(c.Row, col.Column) 'set the found c row of it's hdr column
v2 = dest.Value 'put the dest value into v2 variable
If v1 <> v2 Then dest.Value = v1: dest.Interior.Color = vbYellow 'check, if not match then the dest value is v1 and highlight the dest to yellow
End If
Next i 'continue loop to the next looped cell row offset i
Else 'if the looped cell not found in trg column 2
Set rgKopi = Range(cell, cell.Offset(0, colCount)) 'set the range of the looped cell to the end of the column header into rgKopi variable
trg.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, colCount + 1).Value = rgKopi.Value 'put the rgKopi value into the first blank row after the last row with data in trg column B
End If
Next 'continue loop to the next cell in rg
End Sub
Upvotes: 2