ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Worksheet Functions (https://www.excelbanter.com/excel-worksheet-functions/)
-   -   Macro for Large workbook (https://www.excelbanter.com/excel-worksheet-functions/184631-macro-large-workbook.html)

Jules

Macro for Large workbook
 
Hi, I have a workbook containing approx 80 worksheets, all are exactly a
like. All the sheets names are seven digits (cost centers), these numbers
can be found in the sheet.

I need to delete all the lines not associated with the tab name (which I
have referenced in C3). There are many subtotals in the worksheets; these
consist of staff positions within the cost center.

So, in essence, I have all the cost centers on each tab, but only need the
info for the cost center referenced by the tab.

Is this possible? Can anyone please help me? I'm an intermediate user but
I follow directions fairly well.

Sign me

Despreate in B'more
--
Jules

Per Jessen[_2_]

Macro for Large workbook
 
On 22 Apr., 02:31, Jules wrote:
Hi, I have a workbook containing approx 80 worksheets, all are exactly a
like. *All the sheets names are seven digits (cost centers), these numbers
can be found in the sheet. *

I need to delete all the lines not associated with the tab name (which I
have referenced in C3). *There are many subtotals in the worksheets; these
consist of staff positions within the cost center. *

So, in essence, I have all the cost centers on each tab, but only need the
info for the cost center referenced by the tab. *

Is this possible? *Can anyone please help me? *I'm an intermediate user but
I follow directions fairly well.

Sign me

Despreate in B'more
--
Jules


Hi Jules

In wich column can I find the cost center?

Which row is the first to look at ?

Regards,
Per

Per Jessen[_2_]

Macro for Large workbook
 
On 22 Apr., 02:31, Jules wrote:
Hi, I have a workbook containing approx 80 worksheets, all are exactly a
like. *All the sheets names are seven digits (cost centers), these numbers
can be found in the sheet. *

I need to delete all the lines not associated with the tab name (which I
have referenced in C3). *There are many subtotals in the worksheets; these
consist of staff positions within the cost center. *

So, in essence, I have all the cost centers on each tab, but only need the
info for the cost center referenced by the tab. *

Is this possible? *Can anyone please help me? *I'm an intermediate user but
I follow directions fairly well.

Sign me

Despreate in B'more
--
Jules


Hi

Try this on a copy of your workbook. Change TargetColumn and FirstRow
to suit.

Sub RemoveLines()
Dim sh As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim TargetColumn As String

TargetColumn = "A"
FirstRow = 5

For Each sh In ThisWorkbook.Sheets
CostCenter = sh.Name
With sh
LastRow = .Range("A65536").End(xlUp).Row
For r = LastRow To FirstRow Step -1
If .Cells(r, TargetColumn).Value < CostCenter Then
.Rows(r).Delete
End If
Next
End With
Next
End Sub

Best regards,
Per

Jules

Macro for Large workbook
 
Thanks Per....the macro is having trouble at the End if line...also, I need
to keep the last few lines in tact on each sheet (rows a1368 - 1386) Also,
the row is A6 and the data in the sheet referencing the cost center is in
column G. I don't know if this helps...

Would it be easier to start with the one template and bust out the sheets by
cost center with a different macro? Right now I've used ASAP utilitly to
break out the sheets by cost center...but if you know a better way...?

Thanks so much for all your help.,
--
Jules


"Per Jessen" wrote:

On 22 Apr., 02:31, Jules wrote:
Hi, I have a workbook containing approx 80 worksheets, all are exactly a
like. All the sheets names are seven digits (cost centers), these numbers
can be found in the sheet.

I need to delete all the lines not associated with the tab name (which I
have referenced in C3). There are many subtotals in the worksheets; these
consist of staff positions within the cost center.

So, in essence, I have all the cost centers on each tab, but only need the
info for the cost center referenced by the tab.

Is this possible? Can anyone please help me? I'm an intermediate user but
I follow directions fairly well.

Sign me

Despreate in B'more
--
Jules


Hi

Try this on a copy of your workbook. Change TargetColumn and FirstRow
to suit.

Sub RemoveLines()
Dim sh As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim TargetColumn As String

TargetColumn = "A"
FirstRow = 5

For Each sh In ThisWorkbook.Sheets
CostCenter = sh.Name
With sh
LastRow = .Range("A65536").End(xlUp).Row
For r = LastRow To FirstRow Step -1
If .Cells(r, TargetColumn).Value < CostCenter Then
.Rows(r).Delete
End If
Next
End With
Next
End Sub

Best regards,
Per


Per Jessen

Macro for Large workbook
 
Hi Jules

Does the macro comes up with an error or what is the problem at the end if
line?

This macro will look at rows 6-1367 and delete rows where the CostCenter in
column G is not equal to the cost center on the tab.

Sub RemoveLines()
Dim sh As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim TargetColumn As String

TargetColumn = "G"
FirstRow = 6
LastRow = 1367

For Each sh In ThisWorkbook.Sheets
CostCenter = sh.Name
With sh
For r = LastRow To FirstRow Step -1
If .Cells(r, TargetColumn).Value < CostCenter Then
.Rows(r).Delete
End If
Next
End With
Next
End Sub

Regards,
Per

"Jules" skrev i meddelelsen
...
Thanks Per....the macro is having trouble at the End if line...also, I
need
to keep the last few lines in tact on each sheet (rows a1368 - 1386)
Also,
the row is A6 and the data in the sheet referencing the cost center is in
column G. I don't know if this helps...

Would it be easier to start with the one template and bust out the sheets
by
cost center with a different macro? Right now I've used ASAP utilitly to
break out the sheets by cost center...but if you know a better way...?

Thanks so much for all your help.,
--
Jules


"Per Jessen" wrote:

On 22 Apr., 02:31, Jules wrote:
Hi, I have a workbook containing approx 80 worksheets, all are exactly
a
like. All the sheets names are seven digits (cost centers), these
numbers
can be found in the sheet.

I need to delete all the lines not associated with the tab name (which
I
have referenced in C3). There are many subtotals in the worksheets;
these
consist of staff positions within the cost center.

So, in essence, I have all the cost centers on each tab, but only need
the
info for the cost center referenced by the tab.

Is this possible? Can anyone please help me? I'm an intermediate user
but
I follow directions fairly well.

Sign me

Despreate in B'more
--
Jules


Hi

Try this on a copy of your workbook. Change TargetColumn and FirstRow
to suit.

Sub RemoveLines()
Dim sh As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim TargetColumn As String

TargetColumn = "A"
FirstRow = 5

For Each sh In ThisWorkbook.Sheets
CostCenter = sh.Name
With sh
LastRow = .Range("A65536").End(xlUp).Row
For r = LastRow To FirstRow Step -1
If .Cells(r, TargetColumn).Value < CostCenter Then
.Rows(r).Delete
End If
Next
End With
Next
End Sub

Best regards,
Per



Jules

Macro for Large workbook
 
Hi Per,

I've tried to run this different ways...The workbook has apporx 84 sheets,
all the same...I need to break out each sheet according to the tab name...as
you know.

When I run this (I've tried selecting all sheets and running it as well as
just one sheet), I get the hour glass for about twenty minutes than I end
task and only one sheet has been changed (correctly), the others are not
touched...it doesn't matter how long it runs, you have to end task to get
out...

Just thought I'd update you on this...

Sign me....

Still looking for a fix.

kind regards Per.
--
Jules


"Per Jessen" wrote:

Hi Jules

Does the macro comes up with an error or what is the problem at the end if
line?

This macro will look at rows 6-1367 and delete rows where the CostCenter in
column G is not equal to the cost center on the tab.

Sub RemoveLines()
Dim sh As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim TargetColumn As String

TargetColumn = "G"
FirstRow = 6
LastRow = 1367

For Each sh In ThisWorkbook.Sheets
CostCenter = sh.Name
With sh
For r = LastRow To FirstRow Step -1
If .Cells(r, TargetColumn).Value < CostCenter Then
.Rows(r).Delete
End If
Next
End With
Next
End Sub

Regards,
Per

"Jules" skrev i meddelelsen
...
Thanks Per....the macro is having trouble at the End if line...also, I
need
to keep the last few lines in tact on each sheet (rows a1368 - 1386)
Also,
the row is A6 and the data in the sheet referencing the cost center is in
column G. I don't know if this helps...

Would it be easier to start with the one template and bust out the sheets
by
cost center with a different macro? Right now I've used ASAP utilitly to
break out the sheets by cost center...but if you know a better way...?

Thanks so much for all your help.,
--
Jules


"Per Jessen" wrote:

On 22 Apr., 02:31, Jules wrote:
Hi, I have a workbook containing approx 80 worksheets, all are exactly
a
like. All the sheets names are seven digits (cost centers), these
numbers
can be found in the sheet.

I need to delete all the lines not associated with the tab name (which
I
have referenced in C3). There are many subtotals in the worksheets;
these
consist of staff positions within the cost center.

So, in essence, I have all the cost centers on each tab, but only need
the
info for the cost center referenced by the tab.

Is this possible? Can anyone please help me? I'm an intermediate user
but
I follow directions fairly well.

Sign me

Despreate in B'more
--
Jules

Hi

Try this on a copy of your workbook. Change TargetColumn and FirstRow
to suit.

Sub RemoveLines()
Dim sh As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim TargetColumn As String

TargetColumn = "A"
FirstRow = 5

For Each sh In ThisWorkbook.Sheets
CostCenter = sh.Name
With sh
LastRow = .Range("A65536").End(xlUp).Row
For r = LastRow To FirstRow Step -1
If .Cells(r, TargetColumn).Value < CostCenter Then
.Rows(r).Delete
End If
Next
End With
Next
End Sub

Best regards,
Per




Per Jessen

Macro for Large workbook
 
Hi Jules

I have made a new approach to your problem :-)

The macro creates a new workbook, where the the desired result is copied to.

I have estimated the range to copy, change the CopyRange if it doesn't suit
your needs.

Sub RemoveLines_WithFilter()
Dim ws As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim CostCenter
Dim TargetColumn As String
Dim NewWb As Workbook
Dim OldWb As Workbook
Dim NewWs As Worksheet
Dim CopyRange As String

Application.ScreenUpdating = False
Set OldWb = ThisWorkbook
Set NewWb = Workbooks.Add

CopyRange = "A1:P1386" ' Change to suit the _
range containing data
TargetColumn = "G"
FirstRow = 6
LastRow = 1367
OldWb.Activate

For Each ws In OldWb.Worksheets
Set NewWs = NewWb.Sheets.Add
Debug.Print ws.Name
NewWs.Name = ws.Name
Next

For Each ws In OldWb.Worksheets
CostCenter = ws.Name
ws.Select
Range(Cells(FirstRow, TargetColumn), _
Cells(LastRow, TargetColumn)).Select
Selection.AutoFilter Field:=1, Criteria1:=CostCenter
Range("A1:M45").Copy NewWb.Sheets(CostCenter).Range("A1")
Selection.AutoFilter
Next

Application.ScreenUpdating = True
End Sub

Best regards,
Per

"Jules" skrev i meddelelsen
...
Hi Per,

I've tried to run this different ways...The workbook has apporx 84 sheets,
all the same...I need to break out each sheet according to the tab
name...as
you know.

When I run this (I've tried selecting all sheets and running it as well as
just one sheet), I get the hour glass for about twenty minutes than I end
task and only one sheet has been changed (correctly), the others are not
touched...it doesn't matter how long it runs, you have to end task to get
out...

Just thought I'd update you on this...

Sign me....

Still looking for a fix.

kind regards Per.
--
Jules


"Per Jessen" wrote:

Hi Jules

Does the macro comes up with an error or what is the problem at the end
if
line?

This macro will look at rows 6-1367 and delete rows where the CostCenter
in
column G is not equal to the cost center on the tab.

Sub RemoveLines()
Dim sh As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim TargetColumn As String

TargetColumn = "G"
FirstRow = 6
LastRow = 1367

For Each sh In ThisWorkbook.Sheets
CostCenter = sh.Name
With sh
For r = LastRow To FirstRow Step -1
If .Cells(r, TargetColumn).Value < CostCenter Then
.Rows(r).Delete
End If
Next
End With
Next
End Sub

Regards,
Per

"Jules" skrev i meddelelsen
...
Thanks Per....the macro is having trouble at the End if line...also, I
need
to keep the last few lines in tact on each sheet (rows a1368 - 1386)
Also,
the row is A6 and the data in the sheet referencing the cost center is
in
column G. I don't know if this helps...

Would it be easier to start with the one template and bust out the
sheets
by
cost center with a different macro? Right now I've used ASAP utilitly
to
break out the sheets by cost center...but if you know a better way...?

Thanks so much for all your help.,
--
Jules


"Per Jessen" wrote:

On 22 Apr., 02:31, Jules wrote:
Hi, I have a workbook containing approx 80 worksheets, all are
exactly
a
like. All the sheets names are seven digits (cost centers), these
numbers
can be found in the sheet.

I need to delete all the lines not associated with the tab name
(which
I
have referenced in C3). There are many subtotals in the worksheets;
these
consist of staff positions within the cost center.

So, in essence, I have all the cost centers on each tab, but only
need
the
info for the cost center referenced by the tab.

Is this possible? Can anyone please help me? I'm an intermediate
user
but
I follow directions fairly well.

Sign me

Despreate in B'more
--
Jules

Hi

Try this on a copy of your workbook. Change TargetColumn and FirstRow
to suit.

Sub RemoveLines()
Dim sh As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim TargetColumn As String

TargetColumn = "A"
FirstRow = 5

For Each sh In ThisWorkbook.Sheets
CostCenter = sh.Name
With sh
LastRow = .Range("A65536").End(xlUp).Row
For r = LastRow To FirstRow Step -1
If .Cells(r, TargetColumn).Value < CostCenter Then
.Rows(r).Delete
End If
Next
End With
Next
End Sub

Best regards,
Per





Per Jessen

Macro for Large workbook
 
Just a little correction to the code.

Sub RemoveLines_WithFilter()
Dim ws As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim CostCenter
Dim TargetColumn As String
Dim NewWb As Workbook
Dim OldWb As Workbook
Dim NewWs As Worksheet
Dim CopyRange As String

Application.ScreenUpdating = False
Set OldWb = ThisWorkbook
Set NewWb = Workbooks.Add

CopyRange = "A1:H1386" ' Change to suit the _
range containing data
TargetColumn = "G"
FirstRow = 6
LastRow = 1367
OldWb.Activate

For Each ws In OldWb.Worksheets
Set NewWs = NewWb.Sheets.Add
Debug.Print ws.Name
NewWs.Name = ws.Name
Next

For Each ws In OldWb.Worksheets
CostCenter = ws.Name
ws.Select
Range(Cells(FirstRow, TargetColumn), _
Cells(LastRow, TargetColumn)).Select
Selection.AutoFilter Field:=1, Criteria1:=CostCenter
Range(CopyRange).Copy NewWb.Sheets(CostCenter).Range("A1")
Selection.AutoFilter
Next

Application.ScreenUpdating = True
End Sub

Regards,
Per

"Per Jessen" skrev i meddelelsen
...
Hi Jules

I have made a new approach to your problem :-)

The macro creates a new workbook, where the the desired result is copied
to.

I have estimated the range to copy, change the CopyRange if it doesn't
suit your needs.

Sub RemoveLines_WithFilter()
Dim ws As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim CostCenter
Dim TargetColumn As String
Dim NewWb As Workbook
Dim OldWb As Workbook
Dim NewWs As Worksheet
Dim CopyRange As String

Application.ScreenUpdating = False
Set OldWb = ThisWorkbook
Set NewWb = Workbooks.Add

CopyRange = "A1:P1386" ' Change to suit the _
range containing data
TargetColumn = "G"
FirstRow = 6
LastRow = 1367
OldWb.Activate

For Each ws In OldWb.Worksheets
Set NewWs = NewWb.Sheets.Add
Debug.Print ws.Name
NewWs.Name = ws.Name
Next

For Each ws In OldWb.Worksheets
CostCenter = ws.Name
ws.Select
Range(Cells(FirstRow, TargetColumn), _
Cells(LastRow, TargetColumn)).Select
Selection.AutoFilter Field:=1, Criteria1:=CostCenter
Range("A1:M45").Copy NewWb.Sheets(CostCenter).Range("A1")
Selection.AutoFilter
Next

Application.ScreenUpdating = True
End Sub

Best regards,
Per

"Jules" skrev i meddelelsen
...
Hi Per,

I've tried to run this different ways...The workbook has apporx 84
sheets,
all the same...I need to break out each sheet according to the tab
name...as
you know.

When I run this (I've tried selecting all sheets and running it as well
as
just one sheet), I get the hour glass for about twenty minutes than I end
task and only one sheet has been changed (correctly), the others are not
touched...it doesn't matter how long it runs, you have to end task to get
out...

Just thought I'd update you on this...

Sign me....

Still looking for a fix.

kind regards Per.
--
Jules


"Per Jessen" wrote:

Hi Jules

Does the macro comes up with an error or what is the problem at the end
if
line?

This macro will look at rows 6-1367 and delete rows where the CostCenter
in
column G is not equal to the cost center on the tab.

Sub RemoveLines()
Dim sh As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim TargetColumn As String

TargetColumn = "G"
FirstRow = 6
LastRow = 1367

For Each sh In ThisWorkbook.Sheets
CostCenter = sh.Name
With sh
For r = LastRow To FirstRow Step -1
If .Cells(r, TargetColumn).Value < CostCenter Then
.Rows(r).Delete
End If
Next
End With
Next
End Sub

Regards,
Per

"Jules" skrev i meddelelsen
...
Thanks Per....the macro is having trouble at the End if line...also, I
need
to keep the last few lines in tact on each sheet (rows a1368 - 1386)
Also,
the row is A6 and the data in the sheet referencing the cost center is
in
column G. I don't know if this helps...

Would it be easier to start with the one template and bust out the
sheets
by
cost center with a different macro? Right now I've used ASAP utilitly
to
break out the sheets by cost center...but if you know a better way...?

Thanks so much for all your help.,
--
Jules


"Per Jessen" wrote:

On 22 Apr., 02:31, Jules wrote:
Hi, I have a workbook containing approx 80 worksheets, all are
exactly
a
like. All the sheets names are seven digits (cost centers), these
numbers
can be found in the sheet.

I need to delete all the lines not associated with the tab name
(which
I
have referenced in C3). There are many subtotals in the
worksheets;
these
consist of staff positions within the cost center.

So, in essence, I have all the cost centers on each tab, but only
need
the
info for the cost center referenced by the tab.

Is this possible? Can anyone please help me? I'm an intermediate
user
but
I follow directions fairly well.

Sign me

Despreate in B'more
--
Jules

Hi

Try this on a copy of your workbook. Change TargetColumn and FirstRow
to suit.

Sub RemoveLines()
Dim sh As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim TargetColumn As String

TargetColumn = "A"
FirstRow = 5

For Each sh In ThisWorkbook.Sheets
CostCenter = sh.Name
With sh
LastRow = .Range("A65536").End(xlUp).Row
For r = LastRow To FirstRow Step -1
If .Cells(r, TargetColumn).Value < CostCenter Then
.Rows(r).Delete
End If
Next
End With
Next
End Sub

Best regards,
Per






Jules

Macro for Large workbook
 
Thanks Per...I worked great!
--
Jules


"Per Jessen" wrote:

Just a little correction to the code.

Sub RemoveLines_WithFilter()
Dim ws As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim CostCenter
Dim TargetColumn As String
Dim NewWb As Workbook
Dim OldWb As Workbook
Dim NewWs As Worksheet
Dim CopyRange As String

Application.ScreenUpdating = False
Set OldWb = ThisWorkbook
Set NewWb = Workbooks.Add

CopyRange = "A1:H1386" ' Change to suit the _
range containing data
TargetColumn = "G"
FirstRow = 6
LastRow = 1367
OldWb.Activate

For Each ws In OldWb.Worksheets
Set NewWs = NewWb.Sheets.Add
Debug.Print ws.Name
NewWs.Name = ws.Name
Next

For Each ws In OldWb.Worksheets
CostCenter = ws.Name
ws.Select
Range(Cells(FirstRow, TargetColumn), _
Cells(LastRow, TargetColumn)).Select
Selection.AutoFilter Field:=1, Criteria1:=CostCenter
Range(CopyRange).Copy NewWb.Sheets(CostCenter).Range("A1")
Selection.AutoFilter
Next

Application.ScreenUpdating = True
End Sub

Regards,
Per

"Per Jessen" skrev i meddelelsen
...
Hi Jules

I have made a new approach to your problem :-)

The macro creates a new workbook, where the the desired result is copied
to.

I have estimated the range to copy, change the CopyRange if it doesn't
suit your needs.

Sub RemoveLines_WithFilter()
Dim ws As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim CostCenter
Dim TargetColumn As String
Dim NewWb As Workbook
Dim OldWb As Workbook
Dim NewWs As Worksheet
Dim CopyRange As String

Application.ScreenUpdating = False
Set OldWb = ThisWorkbook
Set NewWb = Workbooks.Add

CopyRange = "A1:P1386" ' Change to suit the _
range containing data
TargetColumn = "G"
FirstRow = 6
LastRow = 1367
OldWb.Activate

For Each ws In OldWb.Worksheets
Set NewWs = NewWb.Sheets.Add
Debug.Print ws.Name
NewWs.Name = ws.Name
Next

For Each ws In OldWb.Worksheets
CostCenter = ws.Name
ws.Select
Range(Cells(FirstRow, TargetColumn), _
Cells(LastRow, TargetColumn)).Select
Selection.AutoFilter Field:=1, Criteria1:=CostCenter
Range("A1:M45").Copy NewWb.Sheets(CostCenter).Range("A1")
Selection.AutoFilter
Next

Application.ScreenUpdating = True
End Sub

Best regards,
Per

"Jules" skrev i meddelelsen
...
Hi Per,

I've tried to run this different ways...The workbook has apporx 84
sheets,
all the same...I need to break out each sheet according to the tab
name...as
you know.

When I run this (I've tried selecting all sheets and running it as well
as
just one sheet), I get the hour glass for about twenty minutes than I end
task and only one sheet has been changed (correctly), the others are not
touched...it doesn't matter how long it runs, you have to end task to get
out...

Just thought I'd update you on this...

Sign me....

Still looking for a fix.

kind regards Per.
--
Jules


"Per Jessen" wrote:

Hi Jules

Does the macro comes up with an error or what is the problem at the end
if
line?

This macro will look at rows 6-1367 and delete rows where the CostCenter
in
column G is not equal to the cost center on the tab.

Sub RemoveLines()
Dim sh As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim TargetColumn As String

TargetColumn = "G"
FirstRow = 6
LastRow = 1367

For Each sh In ThisWorkbook.Sheets
CostCenter = sh.Name
With sh
For r = LastRow To FirstRow Step -1
If .Cells(r, TargetColumn).Value < CostCenter Then
.Rows(r).Delete
End If
Next
End With
Next
End Sub

Regards,
Per

"Jules" skrev i meddelelsen
...
Thanks Per....the macro is having trouble at the End if line...also, I
need
to keep the last few lines in tact on each sheet (rows a1368 - 1386)
Also,
the row is A6 and the data in the sheet referencing the cost center is
in
column G. I don't know if this helps...

Would it be easier to start with the one template and bust out the
sheets
by
cost center with a different macro? Right now I've used ASAP utilitly
to
break out the sheets by cost center...but if you know a better way...?

Thanks so much for all your help.,
--
Jules


"Per Jessen" wrote:

On 22 Apr., 02:31, Jules wrote:
Hi, I have a workbook containing approx 80 worksheets, all are
exactly
a
like. All the sheets names are seven digits (cost centers), these
numbers
can be found in the sheet.

I need to delete all the lines not associated with the tab name
(which
I
have referenced in C3). There are many subtotals in the
worksheets;
these
consist of staff positions within the cost center.

So, in essence, I have all the cost centers on each tab, but only
need
the
info for the cost center referenced by the tab.

Is this possible? Can anyone please help me? I'm an intermediate
user
but
I follow directions fairly well.

Sign me

Despreate in B'more
--
Jules

Hi

Try this on a copy of your workbook. Change TargetColumn and FirstRow
to suit.

Sub RemoveLines()
Dim sh As Variant
Dim LastRow As Double
Dim FirstRow As Double
Dim r As Variant
Dim TargetColumn As String

TargetColumn = "A"
FirstRow = 5

For Each sh In ThisWorkbook.Sheets
CostCenter = sh.Name
With sh
LastRow = .Range("A65536").End(xlUp).Row
For r = LastRow To FirstRow Step -1
If .Cells(r, TargetColumn).Value < CostCenter Then
.Rows(r).Delete
End If
Next
End With
Next
End Sub

Best regards,
Per








All times are GMT +1. The time now is 03:14 AM.

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