couple subs I need help with

[Richard Bridges]

Hi guys,

I'm having trouble writing a couple subs. I'm new to vba, so what I'm asking for may be very complicated. If so, I apologize. So what I'm trying todo is use the workbook as a tool to simplify ordering. People will send in their order sheets, which will be pasted into the master workbook. Therewill be different numbers of order sheets received any given day, so the code would need to take into account a variable number of worksheets. Components are categorized based on the recipe in which they are used, so component 1 in recipe 1 may differ from component 1 in recipe 2. What I would like is to identify components in each sheet that need to be ordered (I was thinking an If...Then loop for values <> 0 in column F) and transfer all values in their rows over to an AllOrders sheet. I would like to then compileall the orders by component onto a TotalComponentry sheet (perhaps by matching strings or equating strings in column A? does vba even have an object for this?), and sum the values of their respective 'order this much' cell. I realize this is probably confusing, so I have prepared a sample xlsm sheet I could send that would probably help a lot in explaining my request. I'm not even sure where to start, so any help would be appreciated. Thanks in advance.

Richard

 

[Ben McClave]

Richard,

Try this code. It will loop through all of the cells in the used range of column F for each sheet in your workbook and copy all rows where the cell value is not equal to zero. Once you have all of the data copied to the "AllOrders" sheet, the easiest way to determine which components to order is with a PivotTable. To facilitate the creation of a PivotTable, the macro concludes by selecting all copied data.

Regards,
Ben

Sub PasteData()
Dim ws As Worksheet
Dim wsSummary As Worksheet
Dim c As Range
Dim rCell(1 To 2) As Range

Set wsSummary = ThisWorkbook.Sheets("AllOrders")
Set rCell(1) = wsSummary.Range("A" & Rows.Count).End(xlUp)

For Each ws In ThisWorkbook.Sheets
With ws
If .Name <> wsSummary.Name Then
For Each c In .Range("F1:F" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row)
If c.Value <> 0 Then
Set rCell(2) = wsSummary.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
c.EntireRow.Copy rCell(2)
End If
Next c
End If
End With
Next ws

Set rCell(2) = wsSummary.Cells(rCell(2).Row, wsSummary.Columns.Count)
Set rCell(2) = rCell(2).End(xlToLeft)
wsSummary.Range(rCell(1), rCell(2)).Select

Set wsSummary = Nothing

End Sub