Copy row values based on drop down to the column

[nuficek]

Hi,
I'm new in VBA and I'm trying to fill in values from the table on the Sheet 2 (rows) based on the cell value on the Sheet 1 (it's dropdown list) and copy these values to the Sheet 1 as column (the same order). There is a table on the Sheet 2 range B3:H18 and the first column (B3:B18) is used as data for drop down list in the cell I2 on the Sheet 1. I need to copy table data in the row range C:H (Sheet 2) matched to the value from the dropdown list (Sheet 1) to the column range D15:D20 (Sheet 1).
I know I can use VLOOKUP function but the problem is, that the values in the column on the Sheet 1 can be overwritten with custom input. Can anyone help me to solve this problem, please? Any help would be really appreciated!

 

[braindiesel]

If the values can be overwritten, then no VBA will prevent that... your VLOOKUP sounds like a good practice.

Here are some approaches for you that might help.
1) Record a macro with the Macro Recorder.
Click one cell with a vlookup in it. Press F2 and hit enter.
Repeat for each of the VLOOKUP cells.
Then stop teh recorder when done.
Your macro will now rewrite each of the formulas if someone overwrites the VLOOKUP
2) Write the VLOOKUPS and save the document as a template... then each time it is a clean open so overwriting is not a concern
3) If you don't want overwriting, protect the cells.

Are any of those tactics helpful?
If not say so and lets see what we can come up with

 

[nuficek]

I've already solved the problem thanks to Tim on this forum:

Copy row values based on drop down to the column

I'm trying to fill in values from the table on the Sheet 2 (rows) based on the cell value on the Sheet 1 (it's dropdown list) and copy these values to the Sheet 1 as column (the same order). There ...

stackoverflow.com

 

[Fluff]

For future reference, while we do allow Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

 

[nuficek]

For future reference, while we do allow Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

Sorry, my mistake. I haven't received any reply for a while so I tried another forum which was more active. So I'm going to put here the result so it can help to other users.
Could you delete my post, please?

 

[Fluff]

Can you please also add a link in your new thread as that is also cross posted.

 

[nuficek]

Here is the solution solved with help of Tim from Copy row values based on drop down to the column

This goes in the code module for ws1:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Me.Range("I2")) Is Nothing Then
        Company_selection
    End If
End Sub
...and in a regular module:

Sub Company_selection()

    Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Dim ws3 As Worksheet: Set ws3 = ThisWorkbook.Sheets("Sheet3")

    Dim tbl As ListObject, m, v

    v = ws1.Range("I2").Value
    If Len(v) > 0 Then

        Set tbl = ws3.ListObjects(1)
        Debug.Print "looking for '" & v & "' in sheet '" & ws3.Name & "' " & _
                tbl.ListColumns(1).DataBodyRange.Address()

        m = Application.Match(ws1.Range("I2").Value, _
                              tbl.ListColumns(1).DataBodyRange, 0)

        If Not IsError(m) Then
             Debug.Print "Found " & v
             ws1.Range("D15:D20").Value = _
               Application.Transpose(tbl.DataBodyRange.Cells(m, 2).Resize(1, 6).Value)
        Else
            'no match
            Debug.Print v & " was not found"
        End If
    Else
        ws1.Range("D15:D20").ClearContents 'clear data if no selection
    End If

End Sub

The only thing is when I change the value in the "N18" nothing happens. I have to change value in "Q:Q" range to project the change in the cells "R". If I make it extra SUB I got "Error 424 Object Required" (I've already asked here Error 424 Object Required)

 

[nuficek]

I was trying to looking for change in the "L18" or range of "Q15:Q28" but it only works if I make a change in the range "Q15:Q28". What am I missing?

Private Sub Worksheet_Change(ByVal Target As Range)
    
Dim Res As Variant
       If Target.CountLarge > 1 Then Exit Sub
       If Not Intersect(Target, Range("L18, Q15:Q28")) Is Nothing Then
          Res = Evaluate("INDEX(N18,MATCH(" & Target.Address & ",J18,0))")
          If Not IsError(Res) Then Target.Offset(, 1) = Res
       End If

End Sub

 

[Fluff]

Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread.
Per forum rules, posts of a duplicate nature will be locked or deleted (rule 12 here: Forum Rules).