mrfrid
02-10-2015, 03:48 AM
Im new to VBA and trying to get help with this macro.
This macro is deleting dublicate EANs (S) based on the highest price (Q) (entire rows).
To work proper for me so shall it delete all dublicate EANs (S) that have the highest price (Q) and highest stock (O) and it shall also delete all dublicate EANs (S) that have dublicate prices (Q) and highest stock (O).
Anyone that can help me with this ?
It's huge amount of data over 10000 rows so manually do this is not a good way.
Someone that can help me re-write the macro so it do this ?
Public Sub DoDelete()
Dim oWS As Worksheet
Dim d As Object, k As Object
Dim a As Range
Dim b As Range
Dim sColumnForMarking As String
Dim iHeaderRowIndex As Integer
Dim i As Integer
Dim iRowsCount As Integer
Dim v As Double
Set oWS = ActiveSheet
Set d = CreateObject("scripting.dictionary")
' ----> Put here ZERO if you do not have a header row !!!
iHeaderRowIndex = 1
' ----> Change this to what ever you like. This will be used to mark the minimum value.
sColumnForMarking = "W"
' Selecting the column "S"
Set a = _
oWS.Range(oWS.Cells(1 + iHeaderRowIndex, "S"), _
oWS.Cells(ActiveSheet.UsedRange.Rows.Count, "S"))
' putting a high number, one that is beyond the max value in column Q
' ----> Change it if it is too low !!!!
For Each b In a
d(b.Text) = 9999999 ' very high number, A max++ to all the prices
Next
For Each b In a
v = CDbl(oWS.Cells(b.Row, "Q").Value)
If v < CDbl(d(b.Text)) Then
d(b.Text) = v
End If
Next
For Each b In a
v = CDbl(oWS.Cells(b.Row, "Q").Value)
If v = CDbl(d(b.Text)) Then
oWS.Cells(b.Row, sColumnForMarking).Value = "MIN"
End If
Next
' This part deletes the lines that are not marked as "MIN".
iRowsCount = oWS.UsedRange.Rows.Count
Application.ScreenUpdating = False
For i = iRowsCount To iHeaderRowIndex + 1 Step -1
If oWS.Cells(i, sColumnForMarking).Text <> "MIN" Then
oWS.Rows(i).Delete Shift:=xlShiftUp
End If
Next
' clean up- deletes the mark column
oWS.Columns(sColumnForMarking).EntireColumn.Delete
Application.ScreenUpdating = True
End Sub
This macro is deleting dublicate EANs (S) based on the highest price (Q) (entire rows).
To work proper for me so shall it delete all dublicate EANs (S) that have the highest price (Q) and highest stock (O) and it shall also delete all dublicate EANs (S) that have dublicate prices (Q) and highest stock (O).
Anyone that can help me with this ?
It's huge amount of data over 10000 rows so manually do this is not a good way.
Someone that can help me re-write the macro so it do this ?
Public Sub DoDelete()
Dim oWS As Worksheet
Dim d As Object, k As Object
Dim a As Range
Dim b As Range
Dim sColumnForMarking As String
Dim iHeaderRowIndex As Integer
Dim i As Integer
Dim iRowsCount As Integer
Dim v As Double
Set oWS = ActiveSheet
Set d = CreateObject("scripting.dictionary")
' ----> Put here ZERO if you do not have a header row !!!
iHeaderRowIndex = 1
' ----> Change this to what ever you like. This will be used to mark the minimum value.
sColumnForMarking = "W"
' Selecting the column "S"
Set a = _
oWS.Range(oWS.Cells(1 + iHeaderRowIndex, "S"), _
oWS.Cells(ActiveSheet.UsedRange.Rows.Count, "S"))
' putting a high number, one that is beyond the max value in column Q
' ----> Change it if it is too low !!!!
For Each b In a
d(b.Text) = 9999999 ' very high number, A max++ to all the prices
Next
For Each b In a
v = CDbl(oWS.Cells(b.Row, "Q").Value)
If v < CDbl(d(b.Text)) Then
d(b.Text) = v
End If
Next
For Each b In a
v = CDbl(oWS.Cells(b.Row, "Q").Value)
If v = CDbl(d(b.Text)) Then
oWS.Cells(b.Row, sColumnForMarking).Value = "MIN"
End If
Next
' This part deletes the lines that are not marked as "MIN".
iRowsCount = oWS.UsedRange.Rows.Count
Application.ScreenUpdating = False
For i = iRowsCount To iHeaderRowIndex + 1 Step -1
If oWS.Cells(i, sColumnForMarking).Text <> "MIN" Then
oWS.Rows(i).Delete Shift:=xlShiftUp
End If
Next
' clean up- deletes the mark column
oWS.Columns(sColumnForMarking).EntireColumn.Delete
Application.ScreenUpdating = True
End Sub