Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations John Tel on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

looping to test for new part # 1

Status
Not open for further replies.

Mack2

Instructor
Mar 12, 2003
336
US
I need to create a new worksheet tab for each unique part number (first column). So when a new part appears, it should grab that row, and insert a new tab with the part number being the name of the worksheet. Does anyone have an idea how to do this? THANKS!!!!!!!!

G1B10008-010 G1BPPRD 08/28/06 121192806
G1B10008-010 G1BPPRD 08/28/06 121192806
G1B10008-011 G1BPPRD 08/28/06 121192806
G1B10008-011 G1BPPRD 08/28/06 121192806
G1B10008-011 G1BPPRD 08/28/06 121192806
G1B10008-012 G1BPPRD 08/28/06 121192806
G1B10008-012 G1BPPRD 08/28/06 121192806
 
This should be a fairly simple order on part number, loop through the cells, check if the value is different than the previous and if it is, create a new sheet named as the value of the cell.

What have you tried so far?

HarleyQuinn
---------------------------------
Get the most out of Tek-Tips, read FAQ222-2244 before posting.
 
For Each cell In Range("e1:e20")
If cell.Value = cell.Offset(1, 0).Value Then
cell.Offset(0, 2).Copy
MsgBox "Same value detected in cells" & " " & Selection.Address & " & " & cell.Offset(0, 1).Address, vbOKOnly
Else
Sheets.Add
Range("F5").Select
cell.PasteSpecial

Exit Sub
 
Hi,

Here is a quick modification of your code to loop through the (currently hardcoded) range of cells and create a new sheet based on each unique value in the first column.

It's not the best code I've ever done, but it should get you started anyway.

You will be able to add any copying of values etc. in yourself around the code.
Code:
Sub Test()

'Cells.Select 'Can be used but not necessary, if used change Cells.Sort to Selection.Sort below

Cells.Sort Key1:=Range("E1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

Sheets.Add , Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheets(1).Cells(1, 5).Value

For Each cell In Sheets(1).Range("E2:E20")
If cell.Value <> cell.Offset(-1, 0).Value Then
Sheets.Add , Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = cell.Value
End If
Next cell

MsgBox "Done!"

End Sub
Hope this helps

HarleyQuinn
---------------------------------
Get the most out of Tek-Tips, read FAQ222-2244 before posting.
 
THAT WORKED!!! Thanks! I had to make a couple of tweaks, but it is creating the tabs perfectly! Thanks again!

For Each cell In Sheets(1).Range("E2:E140")
If cell.Value <> cell.Offset(-1, 0).Value Then
Selection.Offset(0, 2).Select
Selection.Copy
Sheets.Add , Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = cell.Value
ActiveSheet.Select
ActiveSheet.Paste

End If

Next cell
 
Glad I could help, thanks for the star [smile]

HarleyQuinn
---------------------------------
Get the most out of Tek-Tips, read FAQ222-2244 before posting.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top