Some one please help me modify this existing VBA code:
Hello,
I need some serious help. I have a code that should look for certain
part numbers in Col 'J' and if a Part Number is more then the
configurations (you can see the configs in an array of the code), it
should show in 'Delete' sheet those extra rows that contain the Part
and it should add additional part numbers in 'Add' sheet. But, when I
run the code I can see what exactly is happening. Everything is fine
but instead of the row numbers that has been added or deleted in Add
and Delete sheets, I'd want the parts numbers itself. For example in
Sheet "Add" there are new rows with part numbers "OMNISMART300" on it
and vice versa for the "Delete" sheet. Thank you so very much.



code:
--------------------------------------------------------------------------------

Sub Add_Delete_Parts()

Dim c As Long 'Column number
Dim h As Long 'Loop Counter (1)
Dim i As Long 'Loop Counter (2)
Dim j As Long 'Loop Counter (3)
Dim PartsList 'List of parts and numbers of parts
Dim Endrow As Long 'Last row (for loop counter to stop)
Dim Adds As Worksheet 'Where to put 'adds
Dim Dels As Worksheet 'Where to put'deletes'
Dim PartCount As Long 'Count of parts found in loop
Dim HowMany As Boolean 'More than = delete, less than = add



Application.ScreenUpdating = False

'Array. List of parts followed by how many of each required
PartsList = Array("OMNISMART700", 1, "OPTRA-E323", 1, "ATFS71610",
1, _
"TMT88", 2, "PP1000SE", 3, "OMNISMART300", 4, "SUREPOS3", 2, _
"SUREPOS2", 1, "SUREPOS1", 1, "AS50", 5, "DE3000", 5, "1222010", 5)


'Setup Adds sheet
Set Adds = Sheets("Add")
Adds.Cells.ClearContents
'Setup DeletesSheet
Set Dels = Sheets("Delete")
Dels.Cells.ClearContents
'Get 'Add' last row
addl = Adds.Range("a65536").End(xlUp).Row

'get 'Delete' last row
DelL = Dels.Range("a65536").End(xlUp).Row
'Column number to check (J =10)
c = 10

'Lastrow in Column
Endrow = Cells(65536, c).End(xlUp).Row

'Part numbers
For h = LBound(PartsList) To UBound(PartsList) Step 2
'Looks for part number from last row to row 2, deletes if greater than
needed
For i = Endrow To 2 Step -1
If Cells(i, c) = PartsList(h) Then
PartCount = PartCount + 1
If PartCount PartsList(h + 1) Then
Dels.Cells(DelL, 1) = Cells(i, 1).Row
DelL = DelL + 1
Cells(i, 1).EntireRow.Delete
Endrow = Endrow - 1
HowMany = True
End If
End If
Next

'If delete happened jump ahead to next part number
If HowMany = True Or PartCount = PartsList(h + 1) Then
GoTo NextPart
End If

'Else add some
For j = 1 To (PartsList(h + 1) - PartCount)
Cells(Endrow + 1, c) = PartsList(h)
Adds.Cells(addl, 1) = Cells(Endrow + 1, c).Row
addl = addl + 1
Endrow = Endrow + 1
Next

NextPart:
HowMany = False
PartCount = 0
Next

Application.ScreenUpdating = True

End Sub

--------------------------------------------------------------------------------




It will make more sense if you copy and paste this code into module and
run the macro. Make sure though that you have 3 sheets with names;
"Data", "Delete", and "Add". On "Data" sheet Col. "J" you should see
the result. It should look like this: Range J2:J32

OMNISMART700
OPTRA-E323
ATFS71610
TMT88
TMT88
PP1000SE
PP1000SE
PP1000SE
OMNISMART300
OMNISMART300
OMNISMART300
OMNISMART300
SUREPOS3
SUREPOS3
SUREPOS2
SUREPOS1
AS50
AS50
AS50
AS50
AS50
DE3000
DE3000
DE3000
DE3000
DE3000
1222010
1222010
1222010
1222010
1222010

Again, to recap, I want the above result to see in Sheet "Add" since
there was no parts listed when I run the Macro. Consequently, if I had,
lets say Part number "1222010" appeared 10 times, then I want to see it
appear 5 times in "Delete" sheet. I hope I explained it well. This is
just to modify the code and if any one could help me with it, I'd
deeply appreciate it.

Thank you.

_San


--
sanmisds1
------------------------------------------------------------------------
sanmisds1's Profile: http://www.excelforum.com/member.php...o&userid=25241
View this thread: http://www.excelforum.com/showthread...hreadid=387320