Help me modify this VBA code please:

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

San,

just replace Dels.Cells(DelL, 1) = Cells(i, 1).Row
with Dels.Cells(DelL, 1) = Cells(i, 1).Value

and replace Adds.Cells(addl, 1) = Cells(Endrow + 1, c).Row
with Adds.Cells(addl, 1) = Cells(Endrow + 1, c).Value

Fred


"sanmisds1" <[email protected]> wrote in
message news:[email protected]...
>
> 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
>

You're right about the correction, but only to display which part numbers need to be added/deleted instead of displaying the row they were in. Try running the macro a second time. did you notice that for some reason in "Data" sheet it adds the last part number (12220010) the amount of times it is listed to be checked in the array (5)?

And when you have more than the parts needed in the list (which according to San should be deleted), they are not sent to the "Delete" sheet. AND if you have less parts than the list requires, they are added to both the "Data" sheet and the "Add" sheet (plus the additional 5 12220010's for some strange reason).

Also, if there is NO data in column J in the "Data" sheet, then nothing should be displayed in "Data" sheet, only in the "Add" sheet.

These are the problems San is talking about, right?
I've been trying to figure this out too, but I'm still a novice...I'm much better at finding out what the problem(s) is(are).

Hopefully I can help

Originally Posted by Fred

San,

just replace Dels.Cells(DelL, 1) = Cells(i, 1).Row
with Dels.Cells(DelL, 1) = Cells(i, 1).Value

and replace Adds.Cells(addl, 1) = Cells(Endrow + 1, c).Row
with Adds.Cells(addl, 1) = Cells(Endrow + 1, c).Value

Fred

Here you go San. Let me know if this is what you were looking for.

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 As Variant '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 Data As Worksheet
Dim PartCount As Long 'Count of parts found in loop
Dim HowMany As Boolean 'More than = delete, less than = add

Set Data = Sheets("Data")

'Set Data Sheet range J:J to be Text Format
Data.Range("J:J").NumberFormat = "@"

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, c).Value
Cells(i, c).Delete
delL = delL + 1
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).Value
addl = addl + 1
Cells(Endrow + 1, c).Delete
Endrow = Endrow + 1
Next

NextPart:
HowMany = False
PartCount = 0
Next

Application.ScreenUpdating = True

End Sub

Hope this works!!!

Fred and Malik,

Thank you so very much for your time. The codes look great but I have not been able to test it yet..not till tomm morning.
I am just so tired of "overload" work that I am going to collapse.
I will let, both of you, know about it tomm.
Again, deepest thanks to both of you.
Cheers,

-SAN