Excel formula or VBA to paste list of data from reference worksheet if specific text is selected in data worksheet

[Lisa Harris]

Hi, hoping someone can help as I cannot find a solution at all.

I have a workbook with two sheets. One is the active data sheet (sheet 1), the other is a reference / list (sheet 2).

Sheet 2 details across the columns (C:E) the 'Types', and below each type, lists the Tasks for that type (used letters for this example):

1	2	3
a	a	a
b	b	c
c	c	d
d	d
e

<tbody>
</tbody>

<tbody>
</tbody>

Sheet 1 is the data entry sheet. In column F, a 'type' will be selected from a drop down list. When this happens, I need the relevant list for that type on sheet 2, to be pasted in column H on the row of the 'Type' and subsequent rows needed to fit the list. Once this has been done, I would also like the Type cell (column F) to be merged and centered to reach the number of rows the list is, and the same for the title (column G) - please see below (unable to show the merged cells as it sent my table all off - apologies)

column	F	G	H	I	J
	Type	Title	Tasks
	1	title 1	a
			b
			c
			d
			e
	2	title 2	a
			b
			c
			d
	3	title 3	a
			c
			d
	1	title 4	a
			b
			c
			d
			e
	1	title 5	a
			b
			c
			d
			e

<tbody>
</tbody>

Many thanks in advance for any help you can offer

Lisa

 

[mumps]

Sorry... misposted

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab for your sheet1 and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. First insert the title in column G and then make a selection in column F.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim foundVal As Range
    Set foundVal = Sheets("Sheet2").Range("C1:E1").Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not foundVal Is Nothing Then
        Sheets("Sheet2").Range(Sheets("Sheet2").Cells(2, foundVal.Column), Sheets("Sheet2").Cells(6, foundVal.Column)).Copy _
            Cells(Rows.Count, "H").End(xlUp).Offset(1, 0)
        With Range("F" & Target.Row & ":F" & ActiveSheet.Cells(Rows.Count, "H").End(xlUp).Row)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .MergeCells = True
        End With
        With Range("G" & Target.Row & ":G" & ActiveSheet.Cells(Rows.Count, "H").End(xlUp).Row)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .MergeCells = True
        End With
    End If
    Application.ScreenUpdating = True
End Sub

 

[Lisa Harris]

That is fantatsic - Thank you so much! Worked straight away.

Huge thank you. Lisa

 

[mumps]

You are very welcome.