Misc. Leonardo1234 rider@1234 vixer. Highlighting. Simple Early stuff. Avinash Introduction

**DocAElstein** · 03-06-2020, 09:35 PM

Hi

Your explanation is ambiguous. It could be interpreted in different ways.
So I will interpret it as I choose. It will be luck if it gives you what you want......

Looking for highlighted cells requires interaction to the spreadsheet, since no format information is held in Excel values, that is to say using the .Value Property for the complete range will only distinguish Values, Formulas, Dates and Empty cells

But some worksheet functions are efficient, for example Range.Find , SpecilaCells, Copy, Offsett.

The solution that I have chosen to do will involve an initial adjustment so that I can detect the highlighted cells in a different way. Rem 2 makes the cell values formulas: http://www.excelfox.com/forum/showth...ll=1#post12570

Here is the macro, also in macro.xlsm

Code:

Sub PasteHighlightedCellsFromMatchedColumnRows() ' http://www.excelfox.com/forum/showthread.php/2425-Copy-and-paste-by-highlighted-colour
Rem 1 Worksheets info
Dim Ws1 As Worksheet, Ws2 As Worksheet
 Set Ws1 = Workbooks("1.xlsx").Worksheets.Item(1): Set Ws2 = Workbooks("2.xlsx").Worksheets.Item(1)
Rem 2  .... initial adjustment so that I can detect the highlighted cells in a different way
Dim Rng As Range
  For Each Rng In Ws1.UsedRange.Offset(0, 2).Resize(, Ws1.UsedRange.Columns.Count - 2) ' We are intersted in the range offset 2 columns to the left of size 2 columns less than the main used range
    If Rng.Interior.Color = 65535 Then
     Let Rng.Value = "=" & """" & Rng.Value & """"
    Else
    End If
  Next Rng
Rem 3  match column A stock name of 1.xlsx with column B of 2.xlsx and if it matches then copy the yellow highlighted colured cell data in that row of 1.xlsx and paste it to column L OF 2.xlsx
Dim Lr1 As Long: Let Lr1 = Ws1.UsedRange.Rows.Count
  For Each Rng In Ws1.Range("A2:A" & Lr1 & "") '  Ws1 column A
  Dim Lr2 As Long: Let Lr2 = Ws2.UsedRange.Rows.Count
  Dim SrchRng As Range: Set SrchRng = Ws2.Range("B2:B" & Lr2 & "")
  Dim RngMtch As Range
   Set RngMtch = SrchRng.Find(what:=Rng.Value, After:=Ws2.Range("B2"), LookAt:=xlWhole, searchorder:=xlNext, MatchCase:=True) '
    If RngMtch Is Nothing Then
    
    Else ' a cell from column a 1.xlsx is matched to a cell from column B 2.xlsx
    ' copy the yellow highlighted colured cell data in that row of 1.xlsx
     Rng.Offset(0, 1).Resize(, Ws1.UsedRange.Columns.Count - 1).SpecialCells(xlCellTypeFormulas, xlNumbers + xlTextValues).Copy
    ' paste it to column L OF 2.xlsx
     Ws2.Range("L" & RngMtch.Row & "").PasteSpecial Paste:=xlPasteValues
    End If
  Next Rng ' Ws1 column A
Rem 4 save and close both the file after doing the process
Workbooks("1.xlsx").Close savechanges:=False
Workbooks("2.xlsx").Close savechanges:=True
End Sub