If Cell C3 (Sheet2) is equal to any value in Column A (Sheet1) then Copy Matched row from Sheet 1

[Realjoshtodd]

I'm needing some help with creating a VBA code for the following:

If a Name is entered into Cell C3 on Sheet2 in Workbook and it matches any of the Names in Column A on Sheet1. Then I want to copy the entire row of data in sheet1 to Row1 in Sheet2.

 

[L. Howard]

Try this in a standard module.

Assumes the name in sheet 2, C3 and sheet 1, column A are exactly the same.
That is, C3 = Mickey Mouse and the column A name cannot be M. Mouse or Mr. Mickey Mouse.
Each copy overwrites the previous sheet 2, row 1 entry.
If you want the cell address from sheet 1 where the name was found, uncomment the msgbox line.

Howard

Option Explicit

Sub RealjoshtoddFindIt()
Dim nmeFound As Range
Dim nmeFnd As String

nmeFnd = Sheets("Sheet2").Range("C3")

Set nmeFound = Sheets("Sheet1").UsedRange.Find(What:=nmeFnd, _
                                               LookIn:=xlValues, _
                                               LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False)
                                               
If Not nmeFound Is Nothing Then

  nmeFound.EntireRow.Copy Sheets("Sheet2").Range("A1")
   ' MsgBox "Match for " & nmeFnd & " in cell " & nmeFound.Address
   
Else

    MsgBox "No match found for - " & """nmeFound"""
    
End If

End Sub

 

[L. Howard]

This may be a better choice to limit the .UsedRange to column "A"

Howard

Option Explicit

Sub RealjoshtoddFindIt()
Dim nmeFound As Range
Dim nmeFnd As String

nmeFnd = Sheets("Sheet2").Range("C3")

Set nmeFound = Sheets("Sheet1").UsedRange.Columns("A").Find(What:=nmeFnd, _
                                               LookIn:=xlValues, _
                                               LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False)
                                               
If Not nmeFound Is Nothing Then

  nmeFound.EntireRow.Copy Sheets("Sheet2").Range("A1")
   ' MsgBox "Match for " & nmeFnd & " in cell " & nmeFound.Address
   
Else

    MsgBox "No match found for - " & """nmeFound"""
    
End If

End Sub

 

[Realjoshtodd]

This worked perfect, Thank you.

 

[Realjoshtodd]

Is there a way to make the text be colored white when it copies over to Sheet 2?

 

[L. Howard]

Try this, adding the code line shown in RED.

Howard

If Not nmeFound Is Nothing Then

  nmeFound.EntireRow.Copy Sheets("Sheet2").Range("A1")
  [COLOR=#FF0000]Sheets("Sheet2").Rows("1:1").Font.Color = vbWhite[/COLOR]
   ' MsgBox "Match for " & nmeFnd & " in cell " & nmeFound.Address
   
Else

    MsgBox "No match found for - " & """nmeFound"""
    
End If

 

[Realjoshtodd]

Thank you Howard.

 

[L. Howard]

You're welcome, glad it works for you.

Howar

 

[Realjoshtodd]

Howard or others,

I am creating another document that I copied and altered the above code to make work. However now instead of the data being in a row it is in a Column. I'm looking to find a way to make this code work but to continue to make the text white, and make the cell colors copy with no color and no borders, and only copy the value.

It is currently coping everything when I run it (including the border, cell color, and font color. I'm looking to try to narrow it down to only coping Row 5 to whatever in the "G" Column.

Here is the code.


Sub FindIt()
Dim nmeFound As Range
Dim nmeFnd As String
nmeFnd = Sheets("Daily Schedule").Range("N3")
Set nmeFound = Sheets("Daily Assignments").UsedRange.Rows("2").Find(What:=nmeFnd, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not nmeFound Is Nothing Then
nmeFound.EntireColumn.Copy Sheets("Daily Schedule").Range("G1")
Sheets("Daily Schedule").Column("G1:G300").Font.Color = vbWhite
Sheets("Daily Schedule").Column("G1:G300").Cell.Color = vbWhite
' MsgBox "Match for " & nmeFnd & " in cell " & nmeFound.Address

Else
MsgBox "No match found"

End If
End Sub

 

[L. Howard]

Try this, copied to a standard module.

Howard

Sub Realjoshtodd_Findit()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim i As Long, nRow As Long, lRow As Long
    Dim val As Variant
    Set sh1 = Sheets("Daily Schedule")
    Set sh2 = Sheets("Daily Assignments")
    
    lRow = sh1.Cells(Rows.Count, "G").End(xlUp).Row
    nRow = 2
 
    val = Sheets("Daily Schedule").Range("N3")

    For i = 1 To Columns.Count
        If sh2.Cells(nRow, i).Value = val Then
          
           sh2.Cells(nRow, i).EntireColumn.Copy
           
         With Range("G1:G" & lRow)
            .PasteSpecial Paste:=xlPasteValues
            .Font.Color = vbWhite
            .Interior.Color = vbWhite
          End With
         
        End If
    Next I

End Sub