AG3
AG3

Reputation: 51

Highlight the updated cells in excel using vba

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

Answers (1)

karma
karma

Reputation: 2009

Not so sure if I understand you correctly.
Anyway I guess your situation is something like this :

enter image description here

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.

enter image description here

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

Related Questions