ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Opening new worksheets based on entries (https://www.excelbanter.com/excel-programming/368663-opening-new-worksheets-based-entries.html)

RomanR

Opening new worksheets based on entries
 
Hi all,

Got another question about the macro I'm writing. It's an IP address
database, the IPs are all listed in column A as such:

111.222.32.4
111.222.32.5
111.222.32.66
111.222.37.1
111.222.37.2
111.222.37.3
111.222.38.13
111.222.38.24
111.222.38.35

They are class B adresses, and the 3rd octet changes about 220 times
throughout the text files (here I show it change from 32 to 37 to 38).
I need to implement some steps which would open a new worksheet for
every new 3rd octet in the text file. I know I will end up with a
couple hundred sheets, but it's what my boss wants.

Any ideas are more than welcome.

Thanks in advance,

Roman


Tom Ogilvy

Opening new worksheets based on entries
 
Assuming the IP's are column 1 and sorted on the 3rd octet:

Sub copyIP()
Dim sh As Worksheet, Startrow As Long
Dim lastrow As Long, v1, v, i As Long
Set sh = Worksheets("Data")
Startrow = 1
lastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row
ReDim v1(0 To 3)
v1(2) = ""
i = 1
For i = 1 To lastrow
v = Split(sh.Cells(i, 1), ".")
If v(2) < v1(2) And i < 1 Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = v1(2)
sh.Range(sh.Rows(Startrow), sh.Rows(i - 1)).Copy _
ActiveSheet.Range("A1")
Startrow = i
End If
v1 = v
Next i
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = v1(2)
sh.Range(sh.Rows(Startrow), sh.Rows(lastrow)).Copy _
ActiveSheet.Range("A1")
End Sub

--
Regards,
Tom Ogilvy


"RomanR" wrote:

Hi all,

Got another question about the macro I'm writing. It's an IP address
database, the IPs are all listed in column A as such:

111.222.32.4
111.222.32.5
111.222.32.66
111.222.37.1
111.222.37.2
111.222.37.3
111.222.38.13
111.222.38.24
111.222.38.35

They are class B adresses, and the 3rd octet changes about 220 times
throughout the text files (here I show it change from 32 to 37 to 38).
I need to implement some steps which would open a new worksheet for
every new 3rd octet in the text file. I know I will end up with a
couple hundred sheets, but it's what my boss wants.

Any ideas are more than welcome.

Thanks in advance,

Roman



RomanR

Opening new worksheets based on entries
 
Thanks Tom. This line returns a run-time "subscript out of range" error
however:

Set sh = Worksheets("Data")


Thanks

Roman


Tom Ogilvy

Opening new worksheets based on entries
 
I guess I should have said to change Data to reflect the name of the sheet
that contains your data, but I foolishly thought that would be obvious. My
Bad

Let me try again:

The following code is tested and worked with the data you showed and the
assumptions I previously stated. Make sure you change the sheet reference
(worksheets("Data")) to refer to the sheet that contains your data. I placed
your sample data on a sheet named DATA.

Sub copyIP()
Dim sh As Worksheet, Startrow As Long
Dim lastrow As Long, v1, v, i As Long

' change the next line to reflect the sheet that contains
' your data. for example, if your data was on a sheet
' with the name sheet1, the next line would actually be
' Set sh = Worksheets("Sheet1")
' I used the name Data for illustration

Set sh = Worksheets("Data") '<=== CHANGE

Startrow = 1
lastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row
ReDim v1(0 To 3)
v1(2) = ""
i = 1
For i = 1 To lastrow
v = Split(sh.Cells(i, 1), ".")
If v(2) < v1(2) And i < 1 Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = v1(2)
sh.Range(sh.Rows(Startrow), sh.Rows(i - 1)).Copy _
ActiveSheet.Range("A1")
Startrow = i
End If
v1 = v
Next i
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = v1(2)
sh.Range(sh.Rows(Startrow), sh.Rows(lastrow)).Copy _
ActiveSheet.Range("A1")
End Sub


--
Regards,
Tom Ogilvy


"RomanR" wrote:

Thanks Tom. This line returns a run-time "subscript out of range" error
however:

Set sh = Worksheets("Data")


Thanks

Roman



RomanR

Opening new worksheets based on entries
 
It's my fault Tom, don't worry, it is obvious that it has to change. I
figured I had to use the name of my excel file, which I tried, except I
entered the file name (dns.txt) instead of just the sheet name (dns).
That's where I got confused and posted back here. It works wonders now,
thanks very much again for the help, I appreciate it.

Regards,

Roman


Tom Ogilvy wrote:
I guess I should have said to change Data to reflect the name of the sheet
that contains your data, but I foolishly thought that would be obvious. My
Bad

Let me try again:

The following code is tested and worked with the data you showed and the
assumptions I previously stated. Make sure you change the sheet reference
(worksheets("Data")) to refer to the sheet that contains your data. I placed
your sample data on a sheet named DATA.

Sub copyIP()
Dim sh As Worksheet, Startrow As Long
Dim lastrow As Long, v1, v, i As Long

' change the next line to reflect the sheet that contains
' your data. for example, if your data was on a sheet
' with the name sheet1, the next line would actually be
' Set sh = Worksheets("Sheet1")
' I used the name Data for illustration

Set sh = Worksheets("Data") '<=== CHANGE

Startrow = 1
lastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row
ReDim v1(0 To 3)
v1(2) = ""
i = 1
For i = 1 To lastrow
v = Split(sh.Cells(i, 1), ".")
If v(2) < v1(2) And i < 1 Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = v1(2)
sh.Range(sh.Rows(Startrow), sh.Rows(i - 1)).Copy _
ActiveSheet.Range("A1")
Startrow = i
End If
v1 = v
Next i
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = v1(2)
sh.Range(sh.Rows(Startrow), sh.Rows(lastrow)).Copy _
ActiveSheet.Range("A1")
End Sub


--
Regards,
Tom Ogilvy


"RomanR" wrote:

Thanks Tom. This line returns a run-time "subscript out of range" error
however:

Set sh = Worksheets("Data")


Thanks

Roman




Tom Ogilvy

Opening new worksheets based on entries
 
Glad you got it going. And don't mind me; I am not a butt all the time. I
was just playing with your a little <g

--
Regards,
Tom Ogilvy


"RomanR" wrote:

It's my fault Tom, don't worry, it is obvious that it has to change. I
figured I had to use the name of my excel file, which I tried, except I
entered the file name (dns.txt) instead of just the sheet name (dns).
That's where I got confused and posted back here. It works wonders now,
thanks very much again for the help, I appreciate it.

Regards,

Roman


Tom Ogilvy wrote:
I guess I should have said to change Data to reflect the name of the sheet
that contains your data, but I foolishly thought that would be obvious. My
Bad

Let me try again:

The following code is tested and worked with the data you showed and the
assumptions I previously stated. Make sure you change the sheet reference
(worksheets("Data")) to refer to the sheet that contains your data. I placed
your sample data on a sheet named DATA.

Sub copyIP()
Dim sh As Worksheet, Startrow As Long
Dim lastrow As Long, v1, v, i As Long

' change the next line to reflect the sheet that contains
' your data. for example, if your data was on a sheet
' with the name sheet1, the next line would actually be
' Set sh = Worksheets("Sheet1")
' I used the name Data for illustration

Set sh = Worksheets("Data") '<=== CHANGE

Startrow = 1
lastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row
ReDim v1(0 To 3)
v1(2) = ""
i = 1
For i = 1 To lastrow
v = Split(sh.Cells(i, 1), ".")
If v(2) < v1(2) And i < 1 Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = v1(2)
sh.Range(sh.Rows(Startrow), sh.Rows(i - 1)).Copy _
ActiveSheet.Range("A1")
Startrow = i
End If
v1 = v
Next i
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = v1(2)
sh.Range(sh.Rows(Startrow), sh.Rows(lastrow)).Copy _
ActiveSheet.Range("A1")
End Sub


--
Regards,
Tom Ogilvy


"RomanR" wrote:

Thanks Tom. This line returns a run-time "subscript out of range" error
however:

Set sh = Worksheets("Data")


Thanks

Roman






All times are GMT +1. The time now is 06:51 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com