Previous Topic Next Topic

Insert rows with data when criteria is met

Solved/Closed
jan - May 7, 2010 at 11:48 PM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - May 8, 2010 at 01:49 AM
Hi,
Thanks in advance for your help.

I have two tables. If a field in table A is chosen, I want a macro which will insert rows of the data listed in table B into a new sheet.

For instance:
Column Table A Column Table B
Apple Mac
Apple Green
Apple Bartlett

Pear 1
Pear 2
Pear 3

If I chose Apple, i want it in a new sheet :
Row 1 Mac
Row 2 Green
Row 3 Barlett

Thanks,
Related:

1 response

Answer 1 / 1
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
May 8, 2010 at 01:49 AM
introduce row1 and give column headings. now it will look
suppose this is in sheet1
fruit type
Apple Mac
Apple Green
Apple Bartlett

right click this sheets tab and click view code
in the resulting window copy this "event code" 

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
Dim dest As Range, cfind As Range, x As String 
Dim j As Integer, y As String, add As String 
If Target.Column <> 1 Then Exit Sub 
x = Target.Value 
Set cfind = Cells.Find(what:=x) 
j = cfind.Row 
x = cfind.Offset(0, 1).Value 
add = cfind.Address 
With Worksheets("sheet2") 
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 
dest = "row" & " " & j 
dest.Offset(0, 1) = x 
End With 
Do 
Set cfind = Cells.FindNext(cfind) 
If cfind Is Nothing Then Exit Do 
If cfind.Address = add Then Exit Do 
j = cfind.Row 
x = cfind.Offset(0, 1).Value 
With Worksheets("sheet2") 
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 
dest = "row" & " " & j 
dest.Offset(0, 1) = x 
End With 
Loop 
End Sub


now just click apple in sheet 1 and see what you get in sheet 2

the macro undo clears sheet2 so that you can again choose "apple" and
recheck . 

Sub undo() 
Worksheets("sheet2").Cells.Clear 
End Sub
0