Hiker95,
I found a code you posted a few years ago (awesome code btw) but I was wondering if possibly you might could help me with it.
this is the original post. https://www.mrexcel.com/forum/excel...duplicate-records-then-delete-duplicates.html
What I would like for this to do is, look at Column D for Matches and then check for duplicate entries against those results in Col AB, BS, & BW check those rows for duplicate results and delete the dups and SUM the remaining in the first row. I can't delete the rows but I need to clear the extra results in those cells. If they are duplicated clear the cell if they are not add them to the sum.
D AB BS BW
1234 10 200 1000
1234 10 200 1000
1234 10 150 1000
1234 2 150 1000
2345 20 250 2000
Results should be
D AB BS BW
1234 12 350 1000
1234
1234
1234
2345 20 250 2000
any help would be much appreciated, Thanks.
This is how I have modified the code to work with my data so far. Im new to VBS so I'm just leaning and still have a really long ways to go.
I found a code you posted a few years ago (awesome code btw) but I was wondering if possibly you might could help me with it.
this is the original post. https://www.mrexcel.com/forum/excel...duplicate-records-then-delete-duplicates.html
What I would like for this to do is, look at Column D for Matches and then check for duplicate entries against those results in Col AB, BS, & BW check those rows for duplicate results and delete the dups and SUM the remaining in the first row. I can't delete the rows but I need to clear the extra results in those cells. If they are duplicated clear the cell if they are not add them to the sum.
D AB BS BW
1234 10 200 1000
1234 10 200 1000
1234 10 150 1000
1234 2 150 1000
2345 20 250 2000
Results should be
D AB BS BW
1234 12 350 1000
1234
1234
1234
2345 20 250 2000
any help would be much appreciated, Thanks.
This is how I have modified the code to work with my data so far. Im new to VBS so I'm just leaning and still have a really long ways to go.
Code:
Sub ReorgDataSumCount()
' hiker95, 08/02/2012
' http://www.mrexcel.com/forum/showthread.php?650979-VBA-Code-to-Sum-Duplicates
Dim r As Long, lr As Long, n As Long
Dim s As Long, t As Long
' turn off screen updating
Application.ScreenUpdating = False
' clear column FV - FY
Columns("FV:FY").ClearContents
' put 'Deleted' in FV1
' and make it BOLD, and, centered horizontally
With Range("FV1")
.Value = "Deleted"
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
With Range("FW1")
.Value = "Total F1 Cost"
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
With Range("FX1")
.Value = "Total F2 Cost"
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
With Range("FY1")
.Value = "LU Count"
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
Sheets("WPC04").Cells(2, "FW").Formula = "=BT2"
Sheets("WPC04").Cells(2, "FX").Formula = "=BW2"
Sheets("WPC04").Cells(2, "FY").Formula = "=AB2"
' find the lastrow in column D
lr = Cells(Rows.Count, "D").End(xlUp).Row
Range("FW2:FY2").Select
Selection.AutoFill Destination:=Range("FW2:FY" & lr)
Range("FW2:FY" & lr).Select
' sort the raw data by column D, beginning in B2,
' the 1 stands for ascending
Range("A2:FY" & lr).Sort key1:=Range("D2"), order1:=1
' lets loop thru the raw data
' beginning in row 2
For r = 2 To lr
' count how name '41234's are in column 4 = D
n = Application.CountIf(Columns(4), Cells(r, 4).Value)
' if there is only one of them
If n = 1 Then
' put a 0 in column FV, row r
Range("FV" & r) = 0
' is there is more than one
ElseIf n > 1 Then
' put n - 1 in column FV, row r
Range("FV" & r) = n - 1
' the first row for each group
' in each respective column
' put the value of the sum of that range for that column
' in the first row for each column
Range("BT" & r).Value = Evaluate("=Sum(BT" & r & ":BT" & r + n - 1 & ")")
Range("BW" & r).Value = Evaluate("=Sum(BW" & r & ":BW" & r + n - 1 & ")")
Range("AB" & r).Value = Evaluate("=Sum(AB" & r & ":AB" & r + n - 1 & ")")
' then blank out column from the second row of the group
' to the last row of that group
Range("AB" & r + 1 & ":AB" & r + n - 1) = ""
Range("BT" & r + 1 & ":BT" & r + n - 1) = ""
Range("BW" & r + 1 & ":BW" & r + n - 1) = ""
End If
' loop to the next group of items in column B
r = r + n - 1
Next r
' adjust the column widths for column A thru K
Columns("A:FV").AutoFit
' turn screen updatting back on
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
