Couple subs need help with

  • Thread starter Thread starter Richard Bridges
  • Start date Start date
R

Richard Bridges

Hi guys,

I'm trying to write a couple subs in vba. One needs to find any nonzero value from column H in multiple sheets and transfer its value plus any valuesin its row (cells A-G) to the first sheet in the workbook. The second needs to search for matching strings (inventory items) in column A (since I will have multiple entries of the inventory items) of one workbook and sum their integers from column D (inventory total). I would like to then transfer the inventory item and the sum inventory total onto another sheet. I realize this code would be very complicated so even a jumping off point would be greatly appreciated. Thanks in advance.
 
Richard said:
I'm trying to write a couple subs in vba. One needs to find any nonzero
value from column H in multiple sheets and transfer its value plus any
values in its row (cells A-G) to the first sheet in the workbook.
Click to expand...

I assume that "transfer its value" means "copy the value", so... here's
this one:

Sub findNonzeros()
For L0 = 2 To Sheets.Count
For L1 = 1 To Sheets(L0).Cells.SpecialCells(xlCellTypeLastCell).Row
If Sheets(L0).Cells(L1, 8).Value <> 0 Then
x = Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Row + 1
For L2 = 1 To 8
Sheets(1).Cells(x, L2).Value = Sheets(L0).Cells(L1, L2).Value
Next
End If
Next
Next
End Sub

If Sheets(1) isn't where you want the data copied, change the 1 to the name
of the sheet (e.g. Sheets("target sheet")).
The second needs to search for matching strings (inventory items) in
column A (since I will have multiple entries of the inventory items) of
one workbook and sum their integers from column D (inventory total). I
would like to then transfer the inventory item and the sum inventory
total onto another sheet. I realize this code would be very complicated
so even a jumping off point would be greatly appreciated.
Click to expand...

Try this:

Sub matchInventory(what As String, where As Worksheet)
Dim wks As Worksheet
For Each wks In Sheets
If Not (wks Is where) Then
For L0 = 1 To wks.Cells.SpecialCells(xlCellTypeLastCell).Row
'case-sensitive
If (what) = wks.Cells(L0, 1).Value Then
'case-insensitive
'If LCase$(what) = LCase$(wks.Cells(L0, 1).Value) Then
v = v + wks.Cells(L0, 4).Value
End If
Next
End If
Next
x = where.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
where.Cells(x, 1).Value = what
where.Cells(x, 2).Value = v
End Sub

You'll need to call it like this:

matchInventory "Item Name", Sheets("inventory totals")

One line for every inventory item (and change "inventory totals" to the
actual name of the target sheet). If you have some way of automatically
getting the inventory items, you can loop through this, somewhat like so:

Do
x = getNextInventoryItem
If Len(x) Then
matchInventory "Item Name", Sheets("inventory totals")
Else
Exit Do
End If
Loop


Note that for both findNonzeros() and matchInventory(), if you start with a
completely blank target worksheet ("Sheets(1)" in findNonzeros() and
"where" in matchInventory()), you'll end with the top row empty. Shrug.
 
Back
Top