HELP ! VBA and excel......Extract and copy.

[leonpeta]

I'm a newbie and way in over my head, I've tried to extract selectively with a filter to no avail.....so lets try VBA ?

I have two worksheets "Data Collector" and "Quotation".

Data Collector is as follows:
A D E
Product Code Description Qty
A0001 Toy 0
A0002 Tank 0
A0003 Car 3
A0004 Bus 5
A0005 Light 0
A0006 Ball 3
.
.
.
A0020



Quotation is as follows:
B C G
Product Code Description Qty
.
.
.
.
20 lines (max)



What I want to do is press a button and Extract all the lines of data from "Data Collector" ONLY when the Qty >0.

Such that after pressing the button, "quotation" table is populated as follows:

B C G
Product Code Description Qty
A0003 Car 3
A0004 Bus 5
A0006 Ball 3

I suppose that everytime I pressed the button I should clear the worksheet (Quotation Table), before re-populating.

I've been trying to find a why to do it on the fly, but no luck.....so doing it as a "button" is the next best thing.

Any help is hugely appreciated.

Leon

 

[saltkev]

Hi

Try This. it seems to work with your data. I have assumed your data starts in col "a". If my assumptions are wrong you will need to change the ranges in the code, see comments. This will work under a command button.

Dim Fprod
On Error Resume Next
Application.ScreenUpdating = False
Sheets("Quotation").Range("a2:e200").Clear
For Each Fprod In Sheets("Data Collector").Range("A2:A200") 'Where to look in 1st sheet
  If Fprod.Offset(0, 2) > 0 Then ' Search criteria
        
  Fprod.EntireRow.Select
  Selection.Copy
        
  Sheets("Quotation").Activate
  ActiveSheet.Range("a1").Value = "Product Code"
  ActiveSheet.Range("b1").Value = "Description"
  ActiveSheet.Range("c1").Value = "Qty"
              
        ' *** Paste to 2nd Sheet Row 2 ****
        
        If Sheets("Quotation").Range("a2").Value = "" Then
        Sheets("Quotation").Range("a2").Select
        ActiveSheet.Paste
        
        GoTo ender
                
        End If
                
        ' *** Paste to 2nd Sheet Row 3 ****
                
        If Sheets("Quotation").Range("a2").Value > "" And Sheets("Quotation").Range("a3").Value = "" Then
        Sheets("Quotation").Range("a3").Select
        ActiveSheet.Paste
        
        GoTo ender
                
        End If
                
        ' *** Paste to 2nd Sheet Subsequent Rows  ****
                
        If Sheets("Quotation").Range("a2").Value > "" And Sheets("Quotation").Range("a3").Value > "" Then
        Sheets("Quotation").Range("a2").Select
        Selection.End(xlDown).Select
        Selection.Offset(1, 0).Select
        ActiveSheet.Paste
        
        GoTo ender
                
        End If
                
  End If
       
ender:
        Sheets("Data Collector").Activate
        
Next Fprod

regards

Saltkev

 

[repairman615]

Hello,

Have you considered an IF() like:

Excel 2007<TABLE style="BORDER-BOTTOM: #a6aab6 1px solid; BORDER-LEFT: #a6aab6 1px solid; BACKGROUND-COLOR: #ffffff; BORDER-COLLAPSE: collapse; BORDER-TOP: #a6aab6 1px solid; BORDER-RIGHT: #a6aab6 1px solid" rules=all cellPadding=2><COLGROUP><COL style="BACKGROUND-COLOR: #e0e0f0" width=25><COL><COL><COL><COL><COL></COLGROUP><THEAD><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #e0e0f0; COLOR: #161120"><TH></TH><TH>A</TH><TH>B</TH><TH>C</TH><TH>D</TH><TH>E</TH></TR></THEAD><TBODY><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">2</TD><TD style="FONT-WEIGHT: bold">Product Code</TD><TD>Column1</TD><TD>Column2</TD><TD>Description</TD><TD>Qty</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">3</TD><TD>A0001</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Toy</TD><TD style="TEXT-ALIGN: right">0</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">4</TD><TD>A0002</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Tank</TD><TD style="TEXT-ALIGN: right">0</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">5</TD><TD>A0003</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Car</TD><TD style="TEXT-ALIGN: right">3</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">6</TD><TD>A0004</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Bus</TD><TD style="TEXT-ALIGN: right">5</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">7</TD><TD>A0005</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Light</TD><TD style="TEXT-ALIGN: right">0</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">8</TD><TD>A0006</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Ball</TD><TD style="TEXT-ALIGN: right">3</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">9</TD><TD>A0007</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Hat</TD><TD style="TEXT-ALIGN: right">1</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">10</TD><TD>A0008</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Hammer</TD><TD style="TEXT-ALIGN: right">8</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">11</TD><TD>A0009</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Parrot</TD><TD style="TEXT-ALIGN: right">11</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">12</TD><TD>A0010</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Flag</TD><TD style="TEXT-ALIGN: right">8</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">13</TD><TD>A0011</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Umbrella</TD><TD style="TEXT-ALIGN: right">8</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">14</TD><TD>A0012</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Doctor</TD><TD style="TEXT-ALIGN: right">1</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">15</TD><TD>A0013</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Truck</TD><TD style="TEXT-ALIGN: right">2</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">16</TD><TD>A0014</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Marble</TD><TD style="TEXT-ALIGN: right">40</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">17</TD><TD>A0015</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Earth</TD><TD style="TEXT-ALIGN: right">1</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">18</TD><TD>A0016</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Diaper</TD><TD style="TEXT-ALIGN: right">0</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">19</TD><TD>A0017</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Carrot</TD><TD style="TEXT-ALIGN: right">7</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">20</TD><TD>A0018</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Yarn</TD><TD style="TEXT-ALIGN: right">4</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">21</TD><TD>A0019</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Gravel</TD><TD style="TEXT-ALIGN: right">150</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">22</TD><TD>A0020</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>Hatchet</TD><TD style="TEXT-ALIGN: right">0</TD></TR></TBODY></TABLE>

Sheet1​

Excel 2007<TABLE style="BORDER-BOTTOM: #a6aab6 1px solid; BORDER-LEFT: #a6aab6 1px solid; BACKGROUND-COLOR: #ffffff; BORDER-COLLAPSE: collapse; BORDER-TOP: #a6aab6 1px solid; BORDER-RIGHT: #a6aab6 1px solid" rules=all cellPadding=2><COLGROUP><COL style="BACKGROUND-COLOR: #e0e0f0" width=25><COL><COL><COL><COL><COL><COL></COLGROUP><THEAD><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #e0e0f0; COLOR: #161120"><TH></TH><TH>B</TH><TH>C</TH><TH>D</TH><TH>E</TH><TH>F</TH><TH>G</TH></TR></THEAD><TBODY><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">24</TD><TD style="FONT-WEIGHT: bold">Product Code</TD><TD>Description</TD><TD>Column1</TD><TD>Column2</TD><TD>Column3</TD><TD>Qty</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">25</TD><TD>-</TD><TD>-</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>-</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">26</TD><TD>-</TD><TD>-</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>-</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">27</TD><TD>A0003</TD><TD>Car</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">3</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">28</TD><TD>A0004</TD><TD>Bus</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">5</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">29</TD><TD>-</TD><TD>-</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>-</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">30</TD><TD>A0006</TD><TD>Ball</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">3</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">31</TD><TD>A0007</TD><TD>Hat</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">1</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">32</TD><TD>A0008</TD><TD>Hammer</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">8</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">33</TD><TD>A0009</TD><TD>Parrot</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">11</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">34</TD><TD>A0010</TD><TD>Flag</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">8</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">35</TD><TD>A0011</TD><TD>Umbrella</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">8</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">36</TD><TD>A0012</TD><TD>Doctor</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">1</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">37</TD><TD>A0013</TD><TD>Truck</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">2</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">38</TD><TD>A0014</TD><TD>Marble</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">40</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">39</TD><TD>A0015</TD><TD>Earth</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">1</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">40</TD><TD>-</TD><TD>-</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>-</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">41</TD><TD>A0017</TD><TD>Carrot</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">7</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">42</TD><TD>A0018</TD><TD>Yarn</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">4</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">43</TD><TD>A0019</TD><TD>Gravel</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">150</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">44</TD><TD>-</TD><TD>-</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD>-</TD></TR></TBODY></TABLE>

Sheet1​

<TABLE style="BORDER-BOTTOM: black 2px solid; BORDER-LEFT: black 2px solid; PADDING-BOTTOM: 0.4em; BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 0.4em; PADDING-RIGHT: 0.4em; BORDER-COLLAPSE: collapse; BORDER-TOP: black 2px solid; BORDER-RIGHT: black 2px solid; PADDING-TOP: 0.4em" rules=all cellPadding=2 width="85%"><TBODY><TR><TD style="PADDING-BOTTOM: 6px; PADDING-LEFT: 6px; PADDING-RIGHT: 6px; PADDING-TOP: 6px">Worksheet Formulas<TABLE style="BORDER-BOTTOM: #a6aab6 1px solid; TEXT-ALIGN: center; BORDER-LEFT: #a6aab6 1px solid; BACKGROUND-COLOR: #ffffff; BORDER-COLLAPSE: collapse; BORDER-TOP: #a6aab6 1px solid; BORDER-RIGHT: #a6aab6 1px solid" rules=all cellPadding=2 width="100%"><THEAD><TR style="BACKGROUND-COLOR: #e0e0f0; COLOR: #161120"><TH width=10>Cell</TH><TH style="TEXT-ALIGN: left; PADDING-LEFT: 5px">Formula</TH></TR></THEAD><TBODY><TR><TH style="BACKGROUND-COLOR: #e0e0f0; COLOR: #161120" width=10>B25</TH><TD style="TEXT-ALIGN: left">=IF(E3>0,A3,"-")</TD></TR><TR><TH style="BACKGROUND-COLOR: #e0e0f0; COLOR: #161120" width=10>C25</TH><TD style="TEXT-ALIGN: left">=IF(E3>0,D3,"-")</TD></TR><TR><TH style="BACKGROUND-COLOR: #e0e0f0; COLOR: #161120" width=10>G25</TH><TD style="TEXT-ALIGN: left">=IF(E3>0,E3,"-")</TD></TR></TBODY></TABLE></TD></TR></TBODY></TABLE>
These could then be filtered.

 

[Leith Ross]

Hello Leon,

This type of filtering gets a little squirrelly when the columns are contiguous. This macro will separate and copy them as you described. The macro assume that row 1 on both sheets is used for column headers. Copy this code into a standard VBA module in your workbook. You can then create a button on the worksheet and assign the macro to it.

'Written: June 23, 2011
'Author:  Leith Ross
'Thread:  http://www.mrexcel.com/forum/showthread.php?t=559284
'Poster:  leonpeta

Sub FilterAndCopy()
  
  Dim Cell As Range
  Dim DstRng As Range
  Dim DstWks As Worksheet
  Dim LastRow As Long
  Dim N As Long
  Dim SrcRng As Range
  Dim SrcWks As Worksheet
  
    Set SrcWks = Worksheets("Data Collector")
    Set DstWks = Worksheets("Quotation")
    
    Set SrcRng = SrcWks.Range("A2")
    Set DstRng = DstWks.Range("B2:C2,G2")
    
      LastRow = SrcWks.Cells(Rows.Count, SrcRng.Column).End(xlUp).Row
      Set SrcRng = SrcRng.Resize(LastRow - SrcRng.Row + 1, 1)
      
      LastRow = DstWks.Cells(Rows.Count, DstRng.Column).End(xlUp).Row
      If LastRow >= DstRng.Row Then
         DstRng.Areas(1).Resize(RowSize:=LastRow - DstRng.Row + 1).ClearContents
         DstRng.Areas(2).Resize(RowSize:=LastRow - DstRng.Row + 1).ClearContents
      End If
      
      For Each Cell In SrcRng
        If Cell.Offset(0, 4) <> 0 Then
           N = N + 1
           DstRng.Item(N, 1) = Cell
           DstRng.Item(N, 2) = Cell.Offset(0, 3)
           DstRng.Item(N, 6) = Cell.Offset(0, 4)
        End If
      Next Cell
          
End Sub

Adding the Macro (Excel 95 - 2003)

• Copy the macro above pressing the keys CTRL+C
• Open your workbook
• Press the keys ALT+F11 to open the Visual Basic Editor
• Press the keys ALT+I to activate the Insert menu
• Press M to insert a Standard Module
• Paste the code by pressing the keys CTRL+V
  
  [*] Make any custom changes to the macro if needed at this time.
• Save the Macro by pressing the keys CTRL+S
• Press the keys ALT+Q to exit the Editor, and return to Excel.

Sincerely,
Leith Ross