Copy formula to entire column on variable target cell - vba

I'm very new to VBA and there are so many ways to reference a cell and I'm kind of lost here.
My excel sheet comes with the columns swapped around and there is no guarantee that a column will be in the position it was last time but I do know that total number of columns and the column header names are consistent.
So I find my column number using this:
Dim target As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
With ws
Set target = .Range("A1:M1").Find(What:="Target_Column", LookIn:= xlValues, LookAt: = xlWhole, _
MatchCase:=False, SeaarchFormat:=False)
targetCol = target.Column
This gives me the index number of my target column.
Now I want to apply the following function to column "N" in my worksheet (the below formula assumes target column is column "G":
"=RIGHT(G1,LEN(G1)-10)"
I want to use something similar (or easier) than the script below but don't know how to achieve this:
FinalRow = .Cells(.Rows.Count,1).End(xlUp).Row
.Range(.Cells(2,14), .Cells(FinalRow, 14)).FormulaR1C1 =
"=RIGHT(" & targetCol & "1, LEN(" & targetCol & "1)-10)"
I hope the question is clear enough and someone can point me in the right direction.
Thanks.

Based on your description, you may try something like this...
Remember that as per your description, the first formula will be in N2 and will be referencing G1, N2 will be referencing G2 and so on. Make sure that the formula is correct.
Range("N2:N" & FinalRow).Formula = "=RIGHT(" & Cells(1, TargetCol).Address(0, 0) & ",LEN(" & Cells(1, TargetCol).Address(0, 0) & ")-10)"

You may use
.Range(.Cells(2,14), .Cells(FinalRow, 14)).FormulaR1C1 ="=RIGHT(RC" & targetCol & ", LEN(RC" & targetCol & ")-10)"

Maybe something slightly more flexible like:
Option Explicit
Public Sub testing()
Dim wb As Workbook, ws As Worksheet, searchRange As Range, targetColumn As Long, lastRow As Long
Set wb = ThisWorkbook
Set ws = wb.ActiveSheet 'change as appropriate
Const header As String = "MyHeader" '<====Change to header name trying to find
Const startFormulaRow As Long = 2 '<=== change for column to start applying formula at. Assume not 1 as contains header
Const formulaColumn As Long = 14 '<==== change for column you want to apply formula in
Const charsToRemove As Long = 10 '<=== change to different number of characters to remove from len
With ws
Set searchRange = .Range("A1:M1") '<===Change to alternative search range
targetColumn = FindTargetColumn(header, searchRange)
If targetColumn > 0 Then
lastRow = GetLastRow(ws, targetColumn, startFormulaRow)
.Range(.Cells(startFormulaRow, formulaColumn), .Cells(lastRow, formulaColumn)).FormulaR1C1 = "=IFERROR(RIGHT(RC" & targetColumn & ",LEN(RC" & targetColumn & ")-" & charsToRemove & "),"""")"
End If
End With
End Sub
Public Function FindTargetColumn(ByVal header As String, ByVal searchRange As Range) As Long
Dim target As Range
Set target = searchRange.Find(What:=header, LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=False, SearchOrder:=xlRows, SearchFormat:=False)
If Not target Is Nothing Then
FindTargetColumn = target.Column
Else
FindTargetColumn = -1
End If
End Function
Public Function GetLastRow(ByVal ws As Worksheet, ByVal targetColumn, ByVal startFormulaRow As Long) As Long
If Not Application.WorksheetFunction.Subtotal(103, ws.UsedRange) = 0 Then
GetLastRow = ws.Columns(targetColumn).SpecialCells(xlCellTypeLastCell).Row
Else
MsgBox "No data in " & ws.Name & " or last row is < than required formula start row of " & startFormulaRow
End
End If
End Function

Related

Excel VBA: How to sum every row above?

I'm trying to write a formula which does the following:
sum all rows above this one until row 3. (Row 1 and 2 are headers). This code has to go from columns E:AQ, What gets tricky for me is that the row with the last line varies monthly. This month it is row 133, next month it could be 145. Here is my code so far:
Sub Fsum()
Dim Rng1 As Range
Set ws1 = Worksheets("Actuals")
Set Rng1 = ws1.Range("A" & ws1.Rows.Count).End(x1Up)
.Range("Rng1:AQ").Formula = "=sum(???lines above???)"
End Sub
You can see where I get confused. Can someone help?
Here is one way to go about it:
Sub test()
Dim lr As Long
Dim ws As Worksheet
Set ws = Worksheets("Actuals")
With ws
lr = .Cells(1, 5).EntireColumn.Find(what:="*", _
After:=.Cells(1, 5).EntireColumn.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Range(.Cells(lr + 1, 5), .Cells(lr + 1, 43)).Formula = "=Sum(E3:E" & lr & ")"
End With
End Sub
This will find the last used cell in Column E (5 in the code) and set that as the overall last row. Then it will build a sum formula across to column AQ (43 in the code).
Each time you run the code, it will find the last row. So it should be fairly dymanic. If each column has a different last row, that can be done as well, just need to use a loop, but I got the impression that your last row will be different from report to report, not column to column.
Hope this helps!
EDIT*
Here is an alternate way of finding the last row in case the one above gives you problems:
Sub test()
Dim lr As Long
Dim ws As Worksheet
Set ws = Worksheets("Actuals")
With ws
lr = ws.Range("E" & .Rows.Count).End(xlUp).Row
Range(.Cells(lr + 1, 5), .Cells(lr + 1, 43)).Formula = "=Sum(E3:E" & lr & ")"
End With
End Sub
You will need to find the #REF! first and here is something for your reference to find the cell.
Option Explicit
Sub FindRef()
Dim Rng As Range
Dim RefRng As Range
Set Rng = Range("A1:F100") ' Use your own range
Set RefRng = Rng.Find(what:="#REF!", LookIn:=xlValues)
MsgBox "Found the #REF! " & RefRng.Column & RefRng.Row
End Sub

How to pick value based on condition in macros

I want to compare the data so I have to pick a value based on a condition. The example data that I have is like:
The condition is:
I want to pick the value of PO NO. that always placed 2 column after text "PO NO."
How do I get that value? After that copy and paste it in another column (example:column A)
It depends on how do you want to use those values, if you just want to put them into some continued ranges in current workbook, then I think the Filter function is sufficient, if you want to do some further calculation, you may want to write some VBA code:
Press ALT + F11 in your current worksheet.
Press ALT + I then press M.
Press Ctrl + G to open the "Immediate" window
Then write the following lines:
Sub myValues()
Dim rCount As Long
Dim i As Long
Let rCount = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row
For i = 1 to rCount
If WorksheetFunction.Trim(ThisWorkbook.ActiveSheet.Cells(i,6).Text) = "PO No." Then
Debug.Print ThisWorkbook.ActiveSheet.Cells(i,8).Text
End If
Next
End Sub
Now you could get all the PO NO values in the "Immediate" window.
You can extract the value you want using this formula.
=INDEX(F44:H49,MATCH("PO No.",F44:F49,0),3)
The problem which remains to be solved is how to define the range F44:F49. Your question delivers no hint as to how that should be done. Perhaps knowing where you want to value to appear would offer a clue.
You can iterate over each cell in the column and gather your post numbers, offsetted by 2 columns, like I mentioned in comments
Sub Test()
Dim WS As Worksheet
Dim ParamRange As Range
Dim LastRow As Long
Dim Cell As Range
Dim i As Long
Set WS = ActiveSheet 'or whatever sheet your want
With WS
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
Set ParamRange = .Range("F1:F" & LastRow)
End With
For Each Cell In ParamRange 'iterate over column
If Cell.Value2 = "PO NO." Then
i = i + 1
'Debug.Print to Immediate
Debug.Print i, CurrentSearch.Offset(ColumnOffset:=2).Value2
'Paste in "A" column
CurrentSearch.Offset(ColumnOffset:=-5).Value2 = CurrentSearch.Offset(ColumnOffset:=2).Value2
End If
Next
End Sub
So you just need to collect all Cell.Offset(ColumnOffset:=2).Value2 values.
Alternatively, without iteration over cells (and faster), but little bit complicated:
Sub Test()
Dim WS As Worksheet
Dim ParamRange As Range
Dim CurrentSearch As Range
Dim FirstSearch As Range
Dim LastRow As Long
Dim Cell As Range
Dim i As Long
Set WS = ActiveSheet 'or whatever sheet your want
With WS
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
Set ParamRange = .Range("F1:F" & LastRow)
End With
'Get first search
Set CurrentSearch = ParamRange.Find(What:="PO NO.", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not CurrentSearch Is Nothing Then
i = i + 1
'Debug.Print to Immediate
Debug.Print i, CurrentSearch.Offset(ColumnOffset:=2).Value2
'Paste in "A" column
CurrentSearch.Offset(ColumnOffset:=-5).Value2 = CurrentSearch.Offset(ColumnOffset:=2).Value2
Set FirstSearch = CurrentSearch
Do
'Get next search
Set CurrentSearch = ParamRange.FindNext(After:=CurrentSearch)
If Not CurrentSearch Is Nothing Then
If CurrentSearch.Address = FirstSearch.Address Then Exit Do
i = i + 1
'Debug.Print to Immediate
Debug.Print i, CurrentSearch.Offset(ColumnOffset:=2).Value2
'Paste in "A" column
CurrentSearch.Offset(ColumnOffset:=-5).Value2 = CurrentSearch.Offset(ColumnOffset:=2).Value2
Else
Exit Do
End If
Loop
End If
End Sub
Links:
Range.Offset
Find last row, column or last cell
.Find and .FindNext in Excel VBA

VBA Frequency Highlighter Function in Very Large Excel Sheet

In a previous post user: LocEngineer managed to help me to write a finding function that would find the least frequent values in a column of a particular category.
The VBA code works well for the most part with some particular issues, and the previous question had been answered with a sufficiently good answer already, so I thought this required a new post.
LocEngineer: "Holy smoking moly, Batman! If THAT truly is your sheet.... I'd say: forget "UsedRange". That won't work well enough with THAT spread... I've edited the above code using more hardcoded values. Please adapt the values according to your needs and try that. Woah what a mess."
Here is the code:
Sub frequenz()
Dim col As Range, cel As Range
Dim letter As String
Dim lookFor As String
Dim frequency As Long, totalRows As Long
Dim relFrequency As Double
Dim RAN As Range
RAN = ActiveSheet.Range("A6:FS126")
totalRows = 120
For Each col In RAN.Columns
'***get column letter***
letter = Split(ActiveSheet.Cells(1, col.Column).Address, "$")(1)
'*******
For Each cel In col.Cells
lookFor = cel.Text
frequency = Application.WorksheetFunction.CountIf(Range(letter & "2:" & letter & totalRows), lookFor)
relFrequency = frequency / totalRows
If relFrequency <= 0.001 Then
cel.Interior.Color = ColorConstants.vbYellow
End If
Next cel
Next col
End Sub
The Code is formatted like this: (Notice the merged cells that head each column for titles. The titles go down to row 5 and data starts on row 5) (Also Notice that the rows are very much filled with empty columns, sometimes more so than data.)
Finally, one important change I cant figure out is how to get it to ignore blank cells.
Please advise. Thank you.
If the 2 adjustments to be made are to 1. exclude headers, and 2. blank cells
Exclude the headers in way a bit more dynamic; this excludes the top 6 rows:
With ActiveSheet.UsedRange
Set ran = .Offset(6, 0).Resize(.Rows.Count - 6, .Columns.Count)
End With
In the inner For loop, after this line For Each cel In col.Cells you need an IF:
For Each cel In col.Cells
If Len(cel.Value2) > 0 Then...
Here is the modified version (untested):
Option Explicit
Sub frequenz()
Const MIN_ROW As Long = 6
Const MAX_ROW As Long = 120
Dim col As Range
Dim cel As Range
Dim rng As Range
Dim letter As String
Dim lookFor As String
Dim frequency As Long
With ActiveSheet.UsedRange
Set rng = .Offset(MIN_ROW, 0).Resize(MAX_ROW, GetMaxCell.Column)
End With
For Each col In rng.Columns
letter = Split(ActiveSheet.Cells(1, col.Column).Address, "$")(1)
For Each cel In col
lookFor = cel.Value2
If Len(lookFor) > 0 Then 'process non empty values
frequency = WorksheetFunction.CountIf( _
Range(letter & "2:" & letter & MAX_ROW), lookFor)
If frequency / MAX_ROW <= 0.001 Then
cel.Interior.Color = ColorConstants.vbYellow
End If
End If
Next cel
Next col
End Sub
.
Updated to use a new function when determining the last row and column containing values:
Public Function GetMaxCell(Optional ByRef rng As Range = Nothing) As Range
'It returns the last cell of range with data, or A1 if Worksheet is empty
Const NONEMPTY As String = "*"
Dim lRow As Range, lCol As Range
If rng Is Nothing Then Set rng = Application.ActiveWorkbook.ActiveSheet.UsedRange
If WorksheetFunction.CountA(rng) = 0 Then
Set GetMaxCell = rng.Parent.Cells(1, 1)
Else
With rng
Set lRow = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
After:=.Cells(1, 1), _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows)
Set lCol = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
After:=.Cells(1, 1), _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns)
Set GetMaxCell = .Parent.Cells(lRow.Row, lCol.Column)
End With
End If
End Function

VBA check for value in a range

I am trying to loop through a column and if cells = "what i'm lookng for" then do something.
I have this so far, where I'm off is in the if statement where I check for the "name":
Option Explicit
Sub test()
Dim wksDest As Worksheet
Dim wksSource As Worksheet
Dim rngSource As Range
Dim name As String
Dim LastRow As Long
Dim LastCol As Long
Dim c As Long
Application.ScreenUpdating = False
Set wksSource = Worksheets("Sheet1")
With wksSource
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For c = 16 To 20
LastRow = .Cells(.Rows.Count, c).End(xlUp).Row
Set rngSource = .Range(.Cells(5, 16), .Cells(LastRow, 16))
name = rngSource.Value
If name = "mark"
do something
End If
Next c
End With
Application.ScreenUpdating = True
'MsgBox "Done!", vbExclamation
End Sub
OK Chris
Maybe a bit of simplification is required but also a few assumptions.
It doesn't seem like LastCol is being used for anything - so let's assume this is the Column you want to loop through.
Your loop has fixed start and end values yet you are determining the LastRow - so let's assume you want to start from row 5 (in your code) and loop to the LastRow in the LastCol.
In order to determine LastCol you must have data in the row you are using to do this - so let's assume that there are values in row 1 in all columns up to column you want to loop say 16 (in your code).
If you want to (IF) test for a single (string) value in this case then you must arrange for your rngSource to be a single cell value. You also don't need to assign this to a variable unless you need to use it again.
Finally, if you want to check for other values you may want to consider using a SELECT CASE structure in place of your IF THEN structure.
Have a look at the following and change my assumptions to meet your requirement - good luck.
Sub test()
Dim wksDest As Worksheet
Dim wksSource As Worksheet
Dim rngSource As Range
Dim name As String
Dim LastRow As Long
Dim LastCol As Long
Dim c As Long
Application.ScreenUpdating = False
Set wksSource = Worksheets("Sheet1")
With wksSource
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
LastRow = .Cells(Rows.Count, LastCol).End(xlUp).Row
FirstRow = 5
For c = FirstRow To LastRow
If .Range(.Cells(c, LastCol), .Cells(c, LastCol)).Value = "Mark" Then
MsgBox ("do something")
End If
Next c
End With
End Sub
You can just do that with one line.
If Not IsError(Application.Match(ValueToSearchFor, RangeToSearchIn, 0)) Then
'The value found in the given range
End If
Example:
Search for "Canada" in column C of sheet named "Country"
If Not IsError(Application.Match("Canada", Sheets("Country").Range("C:C"), 0)) Then
'The value found in the given range
End If
Pass value to find and Column where value need to be checked. It will return row num if its found else return 0.
Function checkForValue(FindString As String,ColumnToCheck as String) As Long
SheetLastRow = Sheets("Sheet1").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).row
With Sheets("Sheet1").Range("$" & ColumnToCheck & "$1:$" & ColumnToCheck & "$" & CStr(SheetLastRow) )
Set rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
checkForValue = rng.row 'return row its found
'write code you want.
Else
checkForValue = 0
End If
End With
End Function
I tried Hari's suggestion, but Application.Match works weird on range names (not recognizing them...)
Changed to: WorksheetFunction.Match(...
It works, but when value is not present A runtime ERROR jumps before IsError(...) is evaluated.
So I had to write a simple -no looping- solution:
dim Index as Long
Index = -1
On Error Resume Next
Index = WorksheetFunction.Match(Target,Range("Edificios"), 0) 'look for Target value in range named: Edificios
On Error GoTo 0
If Index > 0 Then
' code for existing value found in Range # Index row
End If
Remeber Excel functions first index = 1 (no zero based)
Hope this helps.
I'm guessing what you really want to do is loop through your range rngSource. So try
Set rngSource = .Range(.Cells(5, 16), .Cells(LastRow, 16))
for myCell in rngSource
if myCell.Value = "mark" then
do something
end if
next myCell

Replace a string in Column C based on matching index in Column A

I would appreciate any help on this matter. I am trying to create an Excel 2010 macro in VBA that will read strings in one spreadsheet row by row, and then search another spreadsheet to see if the value exists in a column of strings.
If/When it finds a matching string in column A, I would like to compare the string in column C of the original spreadsheet with the string in Column C of the spreadsheet being searched. If both strings are the same, I would like to move on back to the column A search and continue.
If the strings are different I would like to overwrite the string in Column C of the spreadsheet being searched. I would also like to highlight this change on the searched spreadsheet.
If no matching string is found in column A of the search spreadsheet, then I want to copy the row of the original spreadsheet into the searched spreadsheet and highlight it.
Here's what I have so far, but I can't seem to get it to work properly:
Sub SearchRows()
Dim bottomA1 As Integer
bottomA1 = Sheets("Original Spreadsheet").Range("A" & Rows.Count).End(xlUp).Row
Dim bottomA2 As Integer
bottomA2 = Sheets("Searched Spreadsheet").Range("A" & Rows.Count).End(xlUp).Row
Dim rng1 As Range
Dim rng2 As Range
Dim x As Long
Dim y As Long
Dim foundColumnA As Range
Dim foundColumnC As Range
For Each rng1 In Sheets("Original Spreadsheet").Range("A2:A" & bottomA1)
With Sheets("Searched Spreadsheet").Range("A2:A" & bottomA2)
Set foundColumnA = .Find(what:=rng1, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
For Each rng2 In Sheets("Original Spreadsheet").Range("E2:E" & bottomA1)
With Sheets("Searched Spreadsheet").Range("E2:E" & bottomA2)
Set foundSize = .Find(what:=rng2, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
If foundColumnC Is Nothing Then
bottomE2 = Sheets("Column C Changes").Range("E" & Rows.Count).End(xlUp).Row
y = bottomA2 + 1
rng2.EntireRow.Copy Sheets("Column C Changes").Cells(y, "A")
Sheets("Column C Changes").Cells (y, "A").EntireRow.Interior.ColorIndex = 4
End If
End With
Next rng2
If foundTag Is Nothing Then
bottomA2 = Sheets("Column A Changes").Range("A" & Rows.Count).End(xlUp).Row
x = bottomA2 + 1
rng1.EntireRow.Copy Sheets("Column A Changes").Cells(x, "A")
Sheets("Column A Changes").Cells(x, "A").EntireRow.Interior.ColorIndex = 3
End If
End With
Next rng1
End Sub
You actually have too much code, but they're not set up cleanly. Qualify a lot of things as much as possible so it's cleaner, and try to be consistent with your style. This way you can identify the error as much as possible.
Anyway, on to the code. The basic logic you want is as follows, based on the details above:
Check if a string in Sheet1!A is in Sheet2!A.
If found, compare Column C values.
If Column C values are different, set value of Sheet2 to that in Sheet1 and highlight.
Else, exit.
If not found, copy whole row to Sheet2 and highlight.
Now that we have that written down, it's simpler! :)
Please check my screenshots for my set-up:
SCREENSHOTS:
Sheet1:
Sheet2:
Note that for Sheet2, I don't have BK207 onwards. ;) Now, onto the code.
CODE:
Sub LoopMatchReplace()
Dim ShSrc As Worksheet, ShTar As Worksheet
Dim SrcLRow As Long, TarLRow As Long, NextEmptyRow As Long
Dim RefList As Range, TarList As Range, RefCell As Range, RefColC
Dim TarCell As Range, TarColC As Range
Dim IsFound As Boolean
Dim ToFind As String
With ThisWorkbook
Set ShSrc = .Sheets("Sheet1")
Set ShTar = .Sheets("Sheet2")
End With
'Get the last rows for each sheet.
SrcLRow = ShSrc.Range("A" & Rows.Count).End(xlUp).Row
TarLRow = ShTar.Range("A" & Rows.Count).End(xlUp).Row
'Set the lists to compare.
Set RefList = ShSrc.Range("A2:A" & SrcLRow)
Set TarList = ShTar.Range("A2:A" & TarLRow)
'Initialize boolean, just for kicks.
IsFound = False
'Speed up the process.
Application.ScreenUpdating = False
'Create the loop.
For Each RefCell In RefList
ToFind = RefCell.Value
'Look for the value in our target column.
On Error Resume Next
Set TarCell = TarList.Find(ToFind)
If Not TarCell Is Nothing Then IsFound = True
On Error GoTo 0
'If value exists in target column...
If IsFound Then
'Compare the Column C of both sheets.
Set TarColC = TarCell.Offset(0, 2)
Set RefColC = RefCell.Offset(0, 2)
'If they are different, set the value to match and highlight.
If TarColC.Value <> RefColC.Value Then
TarColC.Value = RefColC.Value
TarColC.Interior.ColorIndex = 4
End If
Else 'If value does not exist...
'Get next empty row, copy the whole row from source sheet, and highlight.
NextEmptyRow = ShTar.Range("A" & Rows.Count).End(xlUp).Row + 1
RefCell.EntireRow.Copy ShTar.Rows(NextEmptyRow)
ShTar.Rows(NextEmptyRow).SpecialCells(xlCellTypeConstants).Interior.ColorIndex = 3
End If
'Set boolean check to False.
IsFound = False
Next RefCell
Application.ScreenUpdating = True
End Sub
Kindly read the comments for the codeblocks so you get an understanding of what I'm doing. Also, note the way that I have qualified everything and properly set them up in a very clean way. Clean code is 50% good code.
Check the following screenshot to see the results after running the code.
END RESULT:
Note the added rows at the end and the changed values in Column C. I did not have the whole row highlighted as I believe that's bad practice and messy, but it's up to you to change the respective lines and values to suit your taste for the end result.
Let us know if this helps.
I think you can use this code.
Values not found will be added to the end of destination sheet.
Differences are signed with a blue(change if you want) background color.
Sub copy_d()
Dim r1 As Long, rfound, vfound
Dim w1, w2, v, lastR As Long, lastC As Long
Set w1 = Sheets("sheet1") ' change the origin sheet at will
Set w2 = Sheets("sheet2") ' change the destination sheet at will
r1 = 1 ' assuming data start in row 1, change it if not
Do While Not IsEmpty(w1.Cells(r1, 1))
v = w1.Cells(r1, 1)
rfound = Application.Match(v, w2.Columns(1), 0) ' look for value
If Not IsError(rfound) Then ' found it?
vfound = w2.Cells(rfound, 3)
If w1.Cells(r1, 3) <> vfound Then ' value in column C is different?
w2.Cells(rfound, 3) = w1.Cells(r1, 3) ' update based on origin sheet
lastC = w2.Cells(rfound, 1).End(xlToRight).Column
w2.Range(w2.Cells(rfound, 1), w2.Cells(rfound, lastC)).Interior.ColorIndex = 5
End If
Else
lastR = w2.Cells(1, 1).End(xlDown).Row + 1
w1.Rows(r1).copy Destination:=w2.Rows(lastR) ' copy to last row of dest sheet
lastC = w2.Cells(lastR, 1).End(xlToRight).Column
w2.Range(w2.Cells(lastR, 1), w2.Cells(lastR, lastC)).Interior.ColorIndex = 5
End If
r1 = r1 + 1
Loop
End Sub