Guanjin Peter
Active Member
- Joined
- May 21, 2008
- Messages
- 429
It's a linked post from:
http://www.excelforum.com/showthread.php?t=647543
http://www.excelforum.com/showthread.php?t=647543
I managed to do the combine the row if column B matches. However column D(quantity, number value), i want the quantity to add-up if column B matches. Any idea how do I modify the code below to do that?
for example:
TDG-**002 Tuna Cheese Pizza Bar (KG) KG 30
TDG-**002 Tuna Cheese Pizza Bar (MG) MG 30
TDG-**002 Tuna Cheese Pizza Bar (KG) KG 30
will combine to become
TDG-**002 Tuna Cheese Pizza Bar (KG) KG 60 <<<< combined
TDG-**002 Tuna Cheese Pizza Bar (MG) MG 30 <<<< left untouched
Code:
Dim lngTMP As Long, iRows As Long
On Error GoTo Fin
Application.ScreenUpdating = False
iRows = Cells(Cells.Rows.Count, 2).End(xlUp).Row
For lngTMP = iRows To 6 Step -1
If WorksheetFunction.CountIf(Columns(2), Cells(lngTMP, 2)) > 1 Then
Rows(lngTMP).Delete
End If
Next lngTMP
Fin:
Application.ScreenUpdating = True
Code:
[LEFT]Private Sub CommandButton1_Click()
Dim wb As Workbook, ws As Worksheet, i As Integer, filess As String
ChDrive Left(ThisWorkbook.Path, 1)
ChDir ThisWorkbook.Path
filess = Dir("template(*).xls")
While filess <> ""
Set wb = Workbooks.Open(filess)
Set ws = wb.Sheets("Sheet1")
Dim intRow As Integer
intRow = 1
Do While ws.Cells(4 + intRow, 1).Value <> ""
i = i + 1
proid = ws.Cells(4 + intRow, 1).Value
pro = ws.Cells(4 + intRow, 2).Value
uom = ws.Cells(4 + intRow, 3).Value
qty = ws.Cells(4 + intRow, 4).Value
ThisWorkbook.Sheets("GrandTotal").Range("a" & 1 + i).End(xlUp).Offset(1, 0).Resize(, 4) = Array(proid, pro & " (" & uom & ")", uom, qty)
intRow = intRow + 1
Loop
ws.Range("a1:d4").Copy
wb.Close savechanges:=False
filess = Dir()
Wend
Dim lngTMP As Long, iRows As Long
On Error GoTo Fin
Application.ScreenUpdating = False
iRows = Cells(Cells.Rows.Count, 2).End(xlUp).Row
For lngTMP = iRows To 6 Step -1
If WorksheetFunction.CountIf(Columns(2), Cells(lngTMP, 2)) > 1 Then
Rows(lngTMP).Delete
End If
Next lngTMP
Fin:
Application.ScreenUpdating = True
Rows("1:1").Insert Shift:=xlDown
Rows("1:1").Insert Shift:=xlDown
Rows("1:1").Insert Shift:=xlDown
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub[/LEFT]