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

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" wrote in
message ...

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 :)

Fred Wrote:
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




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

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!!!


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

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


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