Using Find and resize property to paste entire row

dreen

Board Regular
Joined
Nov 20, 2019
Messages
52
I am trying to use a Find function to find the value of the Active cell in Sheet 2 (I force the active cell to be selected in column A, so if I select "B4", the active cell is "A4").
I would like the Find function to find the value of the "A" active cell from Sheet 2 and find it in Sheet 1, then paste the entire row of the that found row from Sheet 1 into row 2 of Sheet 2.

To break it down:
- Find the value of Sheet 2 column "A" active cell inside of column A in Sheet 1
- Copy the entire row into Sheet 2 row 2 of the found column A in sheet 1

I tried to use a variety of combinations to do this, here is a snapshot of my attempts:

Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole).EntireRow.Value
'Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range("A" & ActiveCell), , xlValues, xlWhole).EntireRow.Value

'Sheet2.Range("A2").Resize(90).Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(Target.Value), , xlValues, xlWhole).Resize(90).Value

'Sheet2.Rows(2).EntireRow.Value = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole).EntireRow.Value

'Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(ActiveCell), , xlValues, xlWhole).Resize(90).Value
'Sheet2.Range("A2").Resize(90).Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(ActiveCell), , xlValues, xlWhole).Resize(90).Value


Below is the entire code, between where the code is commented Testing Below and Testing Above is where my attempts are inside the entire code:

VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    On Error Resume Next                                                                        'Skips any errors and executes the macro further

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    If Target.Row > 2 Then                                                                      'Doesn't Allow the "Titles" in Row 1 to be highlighted or changed

    Application.EnableEvents = False
     
        'ActiveWorkbook.Names.Add Name:="MyRange", RefersToR1C1:=Range("A" & (ActiveCell.Row))   'Defines the name of the ActiveCell as "MyRange" to Autofill VLookup Formula on sheet
     
        Range("A" & (ActiveCell.Row)).Select                                                    'Always Selects Column A depending on the Active Row selecte

        ActiveSheet.UsedRange.Offset(1).EntireRow.Interior.ColorIndex = 0                       'Clears the previous Active Row's interior colour (yellow)

        Target.EntireRow.Interior.Color = RGB(243, 243, 123)                                    'Sets the current Active Row's interior colour (as yellow)

'Testing below

        Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole).EntireRow.Value
        'Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range("A" & ActiveCell), , xlValues, xlWhole).EntireRow.Value
     
        'Sheet2.Range("A2").Resize(90).Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(Target.Value), , xlValues, xlWhole).Resize(90).Value
     
        'Sheet2.Rows(2).EntireRow.Value = Sheet1.Range("A:A").Find(Sheet2.Range("ActiveCell"), , xlValues, xlWhole).EntireRow.Value
   
       'Sheet2.Range("A2").EntireRow.Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(ActiveCell), , xlValues, xlWhole).Resize(90).Value
       'Sheet2.Range("A2").Resize(90).Value = Sheet1.Range("A1:A100000").Find(Sheet2.Range(ActiveCell), , xlValues, xlWhole).Resize(90).Value
     
'Testing above
     
        If Target.Address = "$A$2" Then                                                         'Checks if you have selected Row 2 (The comparison row)

            Target.Value = ""                                                                   'If Cell A2 is selected (the "Key" comparison cell from the comparison row) then a blank value is inputted

        Else                                                                                    'If Cell A2 is not selected

            [a2] = ActiveCell                                                                   'Makes cell "A2" equal to the Active Cell value (The "Key" in this case)

        End If                                                                                  'End IF statement

        Me.Range("B2:CK2").Interior.Color = xlNone                                              'Clears any previous (if any) colouring inside cells

        Dim rng As Range                                                                        'Declares variable as a range to store values

        For Each rng In Me.Range("D2:CK2")                                                      'Declares which columns to highlight yellow if there are any parameters in Sheet 2 that vary from Sheet 1

            If IsNumeric(rng.Value) And IsNumeric(Me.Cells(Target.Row, rng.Column)) Then        '[Exludes the Key, Date, Time & Part columns: hence starting at Column D for highlighting variances]

                If rng.Value <> Me.Cells(Target.Row, rng.Column).Value Then                     'Checks if the parameters vary from the main Database ("HE 171")

                    rng.Interior.Color = vbYellow                                               'Highlights any varying parameters in Yellow

                End If                                                                          'End the first IF statement

            End If                                                                              'End the second IF statement

        Next                                                                                    'Compares the next parameter until it reaches the last parameter

    End If                                                                                      'End the initial IF statement at the beginning of the macro

    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub


Also cross posted on: Using Find functions to paste the found Entire Row
 

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

Watch MrExcel Video

Forum statistics

Threads
1,118,216
Messages
5,570,925
Members
412,351
Latest member
qwertyuiophilip
Top