Text String

[Len]

Hi,

I've a scenario when there is any changes of texts string in excel
worksheet X ( source file ) need to make the same changes in another
worksheet Y ( target file ).
Such changes of texts string are only happen in column A and need to
be bold with red colour after texts string are changed in worksheet Y

How to set a VBA macro to check every rows of column A in worksheet Y
to make the changes of texts string based on the same column A of
worksheet X and then bold them with red colour accordingly ?

E.g.

Wrksheet X
Col A
Row
1 ABC
2 BCD-XY-01
3 EFG-00-84
4 GH
5 HJI
6 01-KLJ

Wrksheet Y
Col A
Row
1 BCD-XY
2 EFG
3 GHI
4 KLJ

After changing the texts string in column A under worksheet Y, the
result of both
worksheets will be similar : -
Wrksheet Y & X
Col A
Row
1 ABC
2 BCD-XY-01
3 EFG-00-84
4 GH
5 HJI
6 01-KLJ

Can anyone help on this problem, thanks a lot
Regards
Len

 

[Rick Rothstein \(MVP - VB\)]

Does this macro do what you want?

Sub UpdateYfromX()
Dim C As Range
Dim X As Long
Dim LastRowX As Long
Dim LastRowY As Long
Dim CellsToColor() As String
LastRowX = Worksheets("Wrksheet X").Cells(Rows.Count, "A").End(xlUp).Row
LastRowY = Worksheets("Wrksheet Y").Cells(Rows.Count, "A").End(xlUp).Row
With Worksheets("Wrksheet X")
ReDim CellsToColor(1 To LastRowX)
For Each C In .Range("A1:A" & LastRowX)
If Worksheets("Wrksheet Y").Range("A:A").Find(What:=C.Value, _
LookAt:=xlWhole) Is Nothing Then CellsToColor(C.Row) = C.Address
Next
.Range("A1:A" & LastRowX).Copy Worksheets("Wrksheet Y").Range("A1")
For X = 1 To LastRowX
If Len(CellsToColor(X)) > 0 Then
.Range(CellsToColor(X)).Cells.Font.Color = vbRed
.Range(CellsToColor(X)).Cells.Font.Bold = True
End If
Next
End With
End Sub

Rick

 

[Len]

Does this macro do what you want?

Sub UpdateYfromX()
  Dim C As Range
  Dim X As Long
  Dim LastRowX As Long
  Dim LastRowY As Long
  Dim CellsToColor() As String
  LastRowX = Worksheets("Wrksheet X").Cells(Rows.Count, "A").End(xlUp).Row
  LastRowY = Worksheets("Wrksheet Y").Cells(Rows.Count, "A").End(xlUp).Row
  With Worksheets("Wrksheet X")
    ReDim CellsToColor(1 To LastRowX)
    For Each C In .Range("A1:A" & LastRowX)
      If Worksheets("Wrksheet Y").Range("A:A").Find(What:=C.Value, _
          LookAt:=xlWhole) Is Nothing Then CellsToColor(C.Row) = C.Address
    Next
    .Range("A1:A" & LastRowX).Copy Worksheets("Wrksheet Y").Range("A1")
    For X = 1 To LastRowX
      If Len(CellsToColor(X)) > 0 Then
        .Range(CellsToColor(X)).Cells.Font.Color = vbRed
        .Range(CellsToColor(X)).Cells.Font.Bold = True
      End If
    Next
  End With
End Sub

Rick











- Show quoted text -

Hi Rick,

Thanks for your prompt reply and your codes works pretty well except
that the changes done need to bold with red colour in wrksht Y instead
of wrksht X.

Further, if wrksht X comes from wrkbook "gl-pl2" and wrksht Y from
wrkbook "PL2" and the changes of texts string such as new texts string
added on need to be inserted in that particular row of wrksht Y and
the texts string being modified stay at the existing row of wrksht Y.
These additional requirements needed in case if there is further data
available on other than column A of wrksht Y.

Can your codes include the above changes !.......... thanks

Regards
Len