Thread: Extracting Data from Tables

Hi guys, I have put together a workbook to prepare quotations for electronic systems which looks something like this (Excel 2010) it's not formatted well in this post, but in this example there are 4 columns headed "Qty", "£ Each", "Description", "Total":-

Qty £ Each Description Total

1 £1,500.00 NR1 System Controller £1,500.00
0 £ 630.50 AR Audio Router
2 £1,200.00 Audio I/P Interface £2,400.00
1 £ 929.50 P500 1 x 500 Watt £ 929.50
0 £1,103.70 P250 1 x 250 Watt
2 £1,300.00 P125 1 x 125 Watt £2,600.00
0 £1,183.00 P60 1 x 60 Watt

It is simple to select the quantity, which then calculates the total, as you can see some items are not included, but having them included in the list for selection acts as an aid de memoir to ensure the correct items are included in the overall system. I have included lots of other functions that automatically calculate the power consumption, equipment rack size, engineering time etc., dependent upon the items included. These figures appear in another tab in the workbook.

The bit I'm stuck with is this; how can I copy the selected items (values, description, £) and omit those with zero quantity to another sheet, or even Word, so that I can use this to send to the customer.

I've played around with VLOOKUP and PivotTable, but I'm not getting very far.

Hope someone can point me in the right direction.

Thanks,

Charles

Its better if you attach a sample workbook than copying the numbers here. Its easier to provide you a solution.

Use this code -

Option Explicit
Dim lrow As Long
Dim i As Long

Sub copy_non_zero()

With Worksheets(1)

    .Range("D2:K2").copy Worksheets(2).Range("A1")

    lrow = .Range("H" & Rows.Count).End(xlUp).Row
    For i = 3 To lrow
        If .Range("D" & i).Value <> "" Then
            .Range("D" & i & ":K" & i).copy Worksheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End If
    Next i
End With

End Sub

Thanx, that helps me alot in my project too!

Charles,

You can do this using autofilter, just uncheck "blanks" and then copy/paste data to a new sheet. If you'd like a macro version:

Sub tgr()
    
    With ActiveSheet.UsedRange
        .AutoFilter 1, "<>"
        .Copy Sheets.Add.Range("A1")
        .AutoFilter
    End With
    
End Sub

Thanks, Arlette / tigeravatar, I assume the code goes into VBA. Never used this, so I'll give it a go and keep my fingers crossed!!

Give this a try:

Sub tgr()
    
    ActiveSheet.Copy Before:=Sheets(1)
    With ActiveSheet.UsedRange
        .AutoFilter 1, "="
        .Offset(1).EntireRow.Delete
        .AutoFilter
    End With
    
End Sub