Appendix Thread. ( Codes for other Threads, etc.) Event Coding Drpdown Data validation

[DocAElstein]

Macro for last post

Sub PasteHighlightedCellsFromMatchedColumnRows2() ' http://www.excelfox.com/forum/showthread.php/2425-Copy-and-paste-by-highlighted-colour-Paste-Highlighted-Cells-From-Matched-Column-Rows?p=12575&viewfull=1#post12575
Rem 1 Worksheets info
Dim Ws1 As Worksheet, Ws2 As Worksheet
 Set Ws1 = Workbooks("1.xlsx").Worksheets.Item("Sheet1"): Set Ws2 = Workbooks("2.xlsx").Worksheets.Item("Sheet1")
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
  For Each Rng In Ws1.Range("A2:L" & Ws1.UsedRange.Rows.Count & "")
    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
    Dim HigChk As Range
     Set HigChk = Rng.Offset(0, 1).Resize(, Ws1.UsedRange.Columns.Count - 1).Find(What:="=", LookIn:=xlFormulas, LookAt:=xlPart)
        If Not HigChk Is Nothing Then ' we found a highlighted cell -----------
        ' 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).Offset(0, 1).Copy
        ' paste it to column L OF 2.xlsx
        Else ' case no highlighted cell, so column B should be copüied from 1.xlsx
         Rng.Offset(0, 1).Copy
        End If                        ' we were looking for highligted cell ---
     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

---

1.xlsx : https://app.box.com/s/dgufdfvw3lm3knkvwvp0xgiqpwarqf69
2.xlsx : https://app.box.com/s/51cykk4zd6ldan8puz70o3zyj0e17rwf
macro.xlsm : https://app.box.com/s/tbis0g4n6l6386df6xjwh4cirbtgphzl