Hi,
I have searched the archives and have found some great stuff, but am still having some troubles.
I have 4 columns in my spreadsheet. I am trying to find any duplicates that may exist in Col A, sum values in Col D, then delete the entire row. So far my sheet before I run my vba code is this.
Col A
100
101
102
105
100
101
102
105
Col D
5
4
2
4
1
2
3
1
After my code is run, I need for my spreadsheet to look like this
Col A
100
101
102
105
Col D
6
6
5
5
I have some code but I still need to do a considerable amount of tweaking to it. Currently my code is only deleting the duplicate values in Col A. I am having difficulty summing the values in Col D as well as deleting the entire row.
Although I have been working with vba on and off for a few months, I am still a beginner.
Any help that you can provide would be most appreciative.
Here is my code thus far....
-------
Public Sub FindDuplicates()
For RwCnt = 1 To (Worksheets(1).Cells(65536, 1).End(xlUp).Row)
SrchValue = Worksheets(1).Cells(RwCnt, 1).Value
If Len(Trim(SrchValue)) > 0 Then
With Worksheets(1).Range("a1:a" & Cells(65536, 1).End(xlUp).Row)
Set c = .Find(SrchValue, LookIn:=xlValues, Lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If c.Address <> firstAddress Then c.Clear
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End If
Next RwCnt
End Sub
------
I have searched the archives and have found some great stuff, but am still having some troubles.
I have 4 columns in my spreadsheet. I am trying to find any duplicates that may exist in Col A, sum values in Col D, then delete the entire row. So far my sheet before I run my vba code is this.
Col A
100
101
102
105
100
101
102
105
Col D
5
4
2
4
1
2
3
1
After my code is run, I need for my spreadsheet to look like this
Col A
100
101
102
105
Col D
6
6
5
5
I have some code but I still need to do a considerable amount of tweaking to it. Currently my code is only deleting the duplicate values in Col A. I am having difficulty summing the values in Col D as well as deleting the entire row.
Although I have been working with vba on and off for a few months, I am still a beginner.
Any help that you can provide would be most appreciative.
Here is my code thus far....
-------
Public Sub FindDuplicates()
For RwCnt = 1 To (Worksheets(1).Cells(65536, 1).End(xlUp).Row)
SrchValue = Worksheets(1).Cells(RwCnt, 1).Value
If Len(Trim(SrchValue)) > 0 Then
With Worksheets(1).Range("a1:a" & Cells(65536, 1).End(xlUp).Row)
Set c = .Find(SrchValue, LookIn:=xlValues, Lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If c.Address <> firstAddress Then c.Clear
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End If
Next RwCnt
End Sub
------