Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Find/Autofilter
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
KT KT is offline
external usenet poster
  
Posts: 47
Default Find/Autofilter
Hi all,

Im having a problem with the following code. The purpose is to create new
sheets from data on OrigSheet for each variable that matches variable found
on Variablesheet.
Sub DivideThis misses the *first* variable even though I can confirm in
the immediate window that it exists. All variables are of same type.

The second problem is when I get to Sub copyData, the sub is being exited
without filtering/copying the data.

Any input much appreciated! :)

Sub divideThis

Dim curVariable As String
Dim i As Integer
Dim lstVariable As Integer
Dim lstrow As Integer

Application.ScreenUpdating = False

With Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" )

lstrow = .Range("b" & Rows.Count).End(xlUp).Row
End With
Debug.Print lstrow

Debug.Print lstVariable

With Workbooks("Myworkbook.Xls").Worksheets("Variablesh eet") ' create a new
sheet
for each variable

lstVariable = .Range("d" & Rows.Count).End(xlUp).Row ' column D
Debug.Print "last variable" & lstVariable
For i = 2 To lstVariable
curVariable = .Cells(i, 4).Value
curVariableName = .Cells(i, 5).Value
Debug.Print "cur " & curVariable & Cells(i, 4).Address(external:=True)
If Not
Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" ).Range("b2:b" &
lstrow).Find(curVariable) Is Nothing _
Then Call createSheet(curVariable, curVariableName) << DOESNT FIND
1ST VARIABLE EVEN THOUGH IT IS IN RANGE. DOES FIND THE REST. NEEDS TO MATCH
*ENTIRE* CELL CONTENTS.

Next i
End With

End Sub

Sub createSheet(curVariable, curVariableName)
Dim newSheet As Worksheet

With Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" ).Activate
On Error Resume Next

Set newSheet = Worksheets.Add
newSheet.Name = curVariable & " " & curVariableName
Call copyData(curVariable)
'On Error GoTo 0
End With
End Sub

Sub copyData(curVariable)
Dim r As Range

With Worksheets("OrigSheet")
lstrow = .Range("b" & Rows.Count).End(xlUp).Row
'MsgBox lstrow
'.AutoFilterMode = False
..Range("a1:k7").Copy Destination:=Worksheets(curVariable).Range("a1") AS
FAR AS I GET
.Range(.Range("b8"), .Range("b" & .Rows.Count).End(xlUp)) AUTOFILTER NEEDS
TO START IN ROW 8. PREV ROWS CONTAIN MERGED CELLS
Debug.Print r.Address(external:=True)
If Application.CountIf(r, curVariable) = 0 Then Exit Sub
..Columns("b7:b" & lstrow).AutoFilter Field:=1, Criteria1:=curVariable
Set r = r.SpecialCells(xlCellTypeVisible)
..AutoFilterMode = False
Range("a1:k7").Copy Destination:=Worksheets(curVariable).Range("a1")
r.EntireRow.Copy Destination:=Worksheets(curVariable).Range("a2")
End With
End Sub

--
KT
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,533
Default Find/Autofilter
Hi

Try this:


Dim newSheet As Worksheet
Dim OrgSh As Worksheet
Dim LstRow As Integer

Sub divideThis()
Dim curVariable As String
Dim i As Integer
Dim lstVariable As Integer
Dim f As Variant

Application.ScreenUpdating = False

Set OrgSh = Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" )
LstRow = OrgSh.Range("b" & Rows.Count).End(xlUp).Row
Debug.Print LstRow

With Workbooks("Myworkbook.Xls").Worksheets("Variablesh eet")
lstVariable = .Range("d" & Rows.Count).End(xlUp).Row ' column D
Debug.Print "last variable" & lstVariable
For i = 2 To lstVariable
curVariable = .Cells(i, 4).Value
curVariableName = .Cells(i, 5).Value
Debug.Print "cur " & curVariable & Cells(i,
4).Address(external:=True)
Set f = OrgSh.Range("B2:B" & LstRow).Find(curVariable, _
After:=OrgSh.Range("B" & LstRow), LookIn:=xlValues,
Lookat:=xlWhole)
If Not f Is Nothing Then
'Create new sheet
Set newSheet =
Worksheets.Add(After:=Worksheets(Worksheets.Count) )
newSheet.Name = curVariable & " " & curVariableName
Set f = Nothing
End If
Next i
End With
Application.ScreenUpdating = True
End Sub


Sub copyData(curVariable)
Dim r As Range

With OrgSh
Set r = .Range("B7", .Range("b" & Rows.Count).End(xlUp))
r.AutoFilter field:=1, Criteria1:=curVariable
Debug.Print r.Address(external:=True)
Set r = r.SpecialCells(xlCellTypeVisible)

If r.Rows.Count 1 Then
.Range("a1:k7").Copy
Destination:=Worksheets(curVariable).Range("a1")
r.EntireRow.Copy Destination:=Worksheets(curVariable).Range("a2")
End If
.AutoFilterMode = False
End With
End Sub


Regards,
Per

"KT" skrev i meddelelsen
...
Hi all,

Im having a problem with the following code. The purpose is to create
new
sheets from data on OrigSheet for each variable that matches variable
found
on Variablesheet.
Sub DivideThis misses the *first* variable even though I can confirm in
the immediate window that it exists. All variables are of same type.

The second problem is when I get to Sub copyData, the sub is being exited
without filtering/copying the data.

Any input much appreciated! :)

Sub divideThis

Dim curVariable As String
Dim i As Integer
Dim lstVariable As Integer
Dim lstrow As Integer

Application.ScreenUpdating = False

With Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" )

lstrow = .Range("b" & Rows.Count).End(xlUp).Row
End With
Debug.Print lstrow

Debug.Print lstVariable

With Workbooks("Myworkbook.Xls").Worksheets("Variablesh eet") ' create a
new
sheet
for each variable

lstVariable = .Range("d" & Rows.Count).End(xlUp).Row ' column D
Debug.Print "last variable" & lstVariable
For i = 2 To lstVariable
curVariable = .Cells(i, 4).Value
curVariableName = .Cells(i, 5).Value
Debug.Print "cur " & curVariable & Cells(i, 4).Address(external:=True)
If Not
Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" ).Range("b2:b" &
lstrow).Find(curVariable) Is Nothing _
Then Call createSheet(curVariable, curVariableName) << DOESNT FIND
1ST VARIABLE EVEN THOUGH IT IS IN RANGE. DOES FIND THE REST. NEEDS TO
MATCH
*ENTIRE* CELL CONTENTS.

Next i
End With

End Sub

Sub createSheet(curVariable, curVariableName)
Dim newSheet As Worksheet

With Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" ).Activate
On Error Resume Next

Set newSheet = Worksheets.Add
newSheet.Name = curVariable & " " & curVariableName
Call copyData(curVariable)
'On Error GoTo 0
End With
End Sub

Sub copyData(curVariable)
Dim r As Range

With Worksheets("OrigSheet")
lstrow = .Range("b" & Rows.Count).End(xlUp).Row
'MsgBox lstrow
'.AutoFilterMode = False
.Range("a1:k7").Copy Destination:=Worksheets(curVariable).Range("a1") AS
FAR AS I GET
.Range(.Range("b8"), .Range("b" & .Rows.Count).End(xlUp)) AUTOFILTER
NEEDS
TO START IN ROW 8. PREV ROWS CONTAIN MERGED CELLS
Debug.Print r.Address(external:=True)
If Application.CountIf(r, curVariable) = 0 Then Exit Sub
.Columns("b7:b" & lstrow).AutoFilter Field:=1, Criteria1:=curVariable
Set r = r.SpecialCells(xlCellTypeVisible)
.AutoFilterMode = False
Range("a1:k7").Copy Destination:=Worksheets(curVariable).Range("a1")
r.EntireRow.Copy Destination:=Worksheets(curVariable).Range("a2")
End With
End Sub

--
KT

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
KT KT is offline
external usenet poster
  
Posts: 47
Default Find/Autofilter
Thanks for the help Per! I was able to get this to work. I did have to
remove
'If r.Rows.Count 1 Then' in order to get the data to copy. Debug.Print
r.Rows.Count showed the rows.count as 1, even though there were nearly a
thousand rows visible.

One more question if you (or anyone else) can help - as I create these
sheets, what is the best way to define them (an array?) so that I can perform
an action on each of these sheets later? I have other sheets in the
workbook, but I will want to be able to reference these specific sheets as
group as in " for each sheet in myArray do 'x' action."

Thanks again.


--
KT


"Per Jessen" wrote:

Hi

Try this:


Dim newSheet As Worksheet
Dim OrgSh As Worksheet
Dim LstRow As Integer

Sub divideThis()
Dim curVariable As String
Dim i As Integer
Dim lstVariable As Integer
Dim f As Variant

Application.ScreenUpdating = False

Set OrgSh = Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" )
LstRow = OrgSh.Range("b" & Rows.Count).End(xlUp).Row
Debug.Print LstRow

With Workbooks("Myworkbook.Xls").Worksheets("Variablesh eet")
lstVariable = .Range("d" & Rows.Count).End(xlUp).Row ' column D
Debug.Print "last variable" & lstVariable
For i = 2 To lstVariable
curVariable = .Cells(i, 4).Value
curVariableName = .Cells(i, 5).Value
Debug.Print "cur " & curVariable & Cells(i,
4).Address(external:=True)
Set f = OrgSh.Range("B2:B" & LstRow).Find(curVariable, _
After:=OrgSh.Range("B" & LstRow), LookIn:=xlValues,
Lookat:=xlWhole)
If Not f Is Nothing Then
'Create new sheet
Set newSheet =
Worksheets.Add(After:=Worksheets(Worksheets.Count) )
newSheet.Name = curVariable & " " & curVariableName
Set f = Nothing
End If
Next i
End With
Application.ScreenUpdating = True
End Sub


Sub copyData(curVariable)
Dim r As Range

With OrgSh
Set r = .Range("B7", .Range("b" & Rows.Count).End(xlUp))
r.AutoFilter field:=1, Criteria1:=curVariable
Debug.Print r.Address(external:=True)
Set r = r.SpecialCells(xlCellTypeVisible)

If r.Rows.Count 1 Then
.Range("a1:k7").Copy
Destination:=Worksheets(curVariable).Range("a1")
r.EntireRow.Copy Destination:=Worksheets(curVariable).Range("a2")
End If
.AutoFilterMode = False
End With
End Sub


Regards,
Per

"KT" skrev i meddelelsen
...
Hi all,

Im having a problem with the following code. The purpose is to create
new
sheets from data on OrigSheet for each variable that matches variable
found
on Variablesheet.
Sub DivideThis misses the *first* variable even though I can confirm in
the immediate window that it exists. All variables are of same type.

The second problem is when I get to Sub copyData, the sub is being exited
without filtering/copying the data.

Any input much appreciated! :)

Sub divideThis

Dim curVariable As String
Dim i As Integer
Dim lstVariable As Integer
Dim lstrow As Integer

Application.ScreenUpdating = False

With Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" )

lstrow = .Range("b" & Rows.Count).End(xlUp).Row
End With
Debug.Print lstrow

Debug.Print lstVariable

With Workbooks("Myworkbook.Xls").Worksheets("Variablesh eet") ' create a
new
sheet
for each variable

lstVariable = .Range("d" & Rows.Count).End(xlUp).Row ' column D
Debug.Print "last variable" & lstVariable
For i = 2 To lstVariable
curVariable = .Cells(i, 4).Value
curVariableName = .Cells(i, 5).Value
Debug.Print "cur " & curVariable & Cells(i, 4).Address(external:=True)
If Not
Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" ).Range("b2:b" &
lstrow).Find(curVariable) Is Nothing _
Then Call createSheet(curVariable, curVariableName) << DOESNT FIND
1ST VARIABLE EVEN THOUGH IT IS IN RANGE. DOES FIND THE REST. NEEDS TO
MATCH
*ENTIRE* CELL CONTENTS.

Next i
End With

End Sub

Sub createSheet(curVariable, curVariableName)
Dim newSheet As Worksheet

With Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" ).Activate
On Error Resume Next

Set newSheet = Worksheets.Add
newSheet.Name = curVariable & " " & curVariableName
Call copyData(curVariable)
'On Error GoTo 0
End With
End Sub

Sub copyData(curVariable)
Dim r As Range

With Worksheets("OrigSheet")
lstrow = .Range("b" & Rows.Count).End(xlUp).Row
'MsgBox lstrow
'.AutoFilterMode = False
.Range("a1:k7").Copy Destination:=Worksheets(curVariable).Range("a1") AS
FAR AS I GET
.Range(.Range("b8"), .Range("b" & .Rows.Count).End(xlUp)) AUTOFILTER
NEEDS
TO START IN ROW 8. PREV ROWS CONTAIN MERGED CELLS
Debug.Print r.Address(external:=True)
If Application.CountIf(r, curVariable) = 0 Then Exit Sub
.Columns("b7:b" & lstrow).AutoFilter Field:=1, Criteria1:=curVariable
Set r = r.SpecialCells(xlCellTypeVisible)
.AutoFilterMode = False
Range("a1:k7").Copy Destination:=Worksheets(curVariable).Range("a1")
r.EntireRow.Copy Destination:=Worksheets(curVariable).Range("a2")
End With
End Sub

--
KT


Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,533
Default Find/Autofilter
KT,
Thanks for your reply, I am glad you made it work.

You can put then in an array for later use, but in this case I think it is
better to use a Collection. See my two examples below:

Sub aaa() 'Array
Dim shArr() As Worksheet
Dim shCount As Long
For Each sh In ThisWorkbook.Sheets
shCount = shCount + 1
ReDim Preserve shArr(1 To shCount)
Set shArr(shCount) = sh
Next
For sh = 1 To UBound(shArr)
Debug.Print shArr(sh).Name
Next
End Sub

Sub bbb() ' Collection
Dim shCol As Collection
Set shCol = New Collection
For Each sh In ThisWorkbook.Sheets
shCol.Add sh
Next
For Each sh In shCol
Debug.Print sh.Name
Next
End Sub

Regards,
Per

"KT" skrev i meddelelsen
...
Thanks for the help Per! I was able to get this to work. I did have to
remove
'If r.Rows.Count 1 Then' in order to get the data to copy.
Debug.Print
r.Rows.Count showed the rows.count as 1, even though there were nearly a
thousand rows visible.

One more question if you (or anyone else) can help - as I create these
sheets, what is the best way to define them (an array?) so that I can
perform
an action on each of these sheets later? I have other sheets in the
workbook, but I will want to be able to reference these specific sheets as
group as in " for each sheet in myArray do 'x' action."

Thanks again.


--
KT


"Per Jessen" wrote:

Hi

Try this:


Dim newSheet As Worksheet
Dim OrgSh As Worksheet
Dim LstRow As Integer

Sub divideThis()
Dim curVariable As String
Dim i As Integer
Dim lstVariable As Integer
Dim f As Variant

Application.ScreenUpdating = False

Set OrgSh = Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" )
LstRow = OrgSh.Range("b" & Rows.Count).End(xlUp).Row
Debug.Print LstRow

With Workbooks("Myworkbook.Xls").Worksheets("Variablesh eet")
lstVariable = .Range("d" & Rows.Count).End(xlUp).Row ' column D
Debug.Print "last variable" & lstVariable
For i = 2 To lstVariable
curVariable = .Cells(i, 4).Value
curVariableName = .Cells(i, 5).Value
Debug.Print "cur " & curVariable & Cells(i,
4).Address(external:=True)
Set f = OrgSh.Range("B2:B" & LstRow).Find(curVariable, _
After:=OrgSh.Range("B" & LstRow), LookIn:=xlValues,
Lookat:=xlWhole)
If Not f Is Nothing Then
'Create new sheet
Set newSheet =
Worksheets.Add(After:=Worksheets(Worksheets.Count) )
newSheet.Name = curVariable & " " & curVariableName
Set f = Nothing
End If
Next i
End With
Application.ScreenUpdating = True
End Sub


Sub copyData(curVariable)
Dim r As Range

With OrgSh
Set r = .Range("B7", .Range("b" & Rows.Count).End(xlUp))
r.AutoFilter field:=1, Criteria1:=curVariable
Debug.Print r.Address(external:=True)
Set r = r.SpecialCells(xlCellTypeVisible)

If r.Rows.Count 1 Then
.Range("a1:k7").Copy
Destination:=Worksheets(curVariable).Range("a1")
r.EntireRow.Copy Destination:=Worksheets(curVariable).Range("a2")
End If
.AutoFilterMode = False
End With
End Sub


Regards,
Per

"KT" skrev i meddelelsen
...
Hi all,

Im having a problem with the following code. The purpose is to create
new
sheets from data on OrigSheet for each variable that matches variable
found
on Variablesheet.
Sub DivideThis misses the *first* variable even though I can confirm
in
the immediate window that it exists. All variables are of same type.

The second problem is when I get to Sub copyData, the sub is being
exited
without filtering/copying the data.

Any input much appreciated! :)

Sub divideThis

Dim curVariable As String
Dim i As Integer
Dim lstVariable As Integer
Dim lstrow As Integer

Application.ScreenUpdating = False

With Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" )

lstrow = .Range("b" & Rows.Count).End(xlUp).Row
End With
Debug.Print lstrow

Debug.Print lstVariable

With Workbooks("Myworkbook.Xls").Worksheets("Variablesh eet") ' create a
new
sheet
for each variable

lstVariable = .Range("d" & Rows.Count).End(xlUp).Row ' column D
Debug.Print "last variable" & lstVariable
For i = 2 To lstVariable
curVariable = .Cells(i, 4).Value
curVariableName = .Cells(i, 5).Value
Debug.Print "cur " & curVariable & Cells(i,
4).Address(external:=True)
If Not
Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" ).Range("b2:b" &
lstrow).Find(curVariable) Is Nothing _
Then Call createSheet(curVariable, curVariableName) << DOESNT
FIND
1ST VARIABLE EVEN THOUGH IT IS IN RANGE. DOES FIND THE REST. NEEDS TO
MATCH
*ENTIRE* CELL CONTENTS.

Next i
End With

End Sub

Sub createSheet(curVariable, curVariableName)
Dim newSheet As Worksheet

With Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" ).Activate
On Error Resume Next

Set newSheet = Worksheets.Add
newSheet.Name = curVariable & " " & curVariableName
Call copyData(curVariable)
'On Error GoTo 0
End With
End Sub

Sub copyData(curVariable)
Dim r As Range

With Worksheets("OrigSheet")
lstrow = .Range("b" & Rows.Count).End(xlUp).Row
'MsgBox lstrow
'.AutoFilterMode = False
.Range("a1:k7").Copy Destination:=Worksheets(curVariable).Range("a1")
AS
FAR AS I GET
.Range(.Range("b8"), .Range("b" & .Rows.Count).End(xlUp)) AUTOFILTER
NEEDS
TO START IN ROW 8. PREV ROWS CONTAIN MERGED CELLS
Debug.Print r.Address(external:=True)
If Application.CountIf(r, curVariable) = 0 Then Exit Sub
.Columns("b7:b" & lstrow).AutoFilter Field:=1, Criteria1:=curVariable
Set r = r.SpecialCells(xlCellTypeVisible)
.AutoFilterMode = False
Range("a1:k7").Copy Destination:=Worksheets(curVariable).Range("a1")
r.EntireRow.Copy Destination:=Worksheets(curVariable).Range("a2")
End With
End Sub

--
KT



Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
KT KT is offline
external usenet poster
  
Posts: 47
Default Find/Autofilter
Per -

Thanks for getting me started down the right path ... I appreciate your kind
assistance!

--
KT


"Per Jessen" wrote:

KT,
Thanks for your reply, I am glad you made it work.

You can put then in an array for later use, but in this case I think it is
better to use a Collection. See my two examples below:

Sub aaa() 'Array
Dim shArr() As Worksheet
Dim shCount As Long
For Each sh In ThisWorkbook.Sheets
shCount = shCount + 1
ReDim Preserve shArr(1 To shCount)
Set shArr(shCount) = sh
Next
For sh = 1 To UBound(shArr)
Debug.Print shArr(sh).Name
Next
End Sub

Sub bbb() ' Collection
Dim shCol As Collection
Set shCol = New Collection
For Each sh In ThisWorkbook.Sheets
shCol.Add sh
Next
For Each sh In shCol
Debug.Print sh.Name
Next
End Sub

Regards,
Per

"KT" skrev i meddelelsen
...
Thanks for the help Per! I was able to get this to work. I did have to
remove
'If r.Rows.Count 1 Then' in order to get the data to copy.
Debug.Print
r.Rows.Count showed the rows.count as 1, even though there were nearly a
thousand rows visible.

One more question if you (or anyone else) can help - as I create these
sheets, what is the best way to define them (an array?) so that I can
perform
an action on each of these sheets later? I have other sheets in the
workbook, but I will want to be able to reference these specific sheets as
group as in " for each sheet in myArray do 'x' action."

Thanks again.


--
KT


"Per Jessen" wrote:

Hi

Try this:


Dim newSheet As Worksheet
Dim OrgSh As Worksheet
Dim LstRow As Integer

Sub divideThis()
Dim curVariable As String
Dim i As Integer
Dim lstVariable As Integer
Dim f As Variant

Application.ScreenUpdating = False

Set OrgSh = Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" )
LstRow = OrgSh.Range("b" & Rows.Count).End(xlUp).Row
Debug.Print LstRow

With Workbooks("Myworkbook.Xls").Worksheets("Variablesh eet")
lstVariable = .Range("d" & Rows.Count).End(xlUp).Row ' column D
Debug.Print "last variable" & lstVariable
For i = 2 To lstVariable
curVariable = .Cells(i, 4).Value
curVariableName = .Cells(i, 5).Value
Debug.Print "cur " & curVariable & Cells(i,
4).Address(external:=True)
Set f = OrgSh.Range("B2:B" & LstRow).Find(curVariable, _
After:=OrgSh.Range("B" & LstRow), LookIn:=xlValues,
Lookat:=xlWhole)
If Not f Is Nothing Then
'Create new sheet
Set newSheet =
Worksheets.Add(After:=Worksheets(Worksheets.Count) )
newSheet.Name = curVariable & " " & curVariableName
Set f = Nothing
End If
Next i
End With
Application.ScreenUpdating = True
End Sub


Sub copyData(curVariable)
Dim r As Range

With OrgSh
Set r = .Range("B7", .Range("b" & Rows.Count).End(xlUp))
r.AutoFilter field:=1, Criteria1:=curVariable
Debug.Print r.Address(external:=True)
Set r = r.SpecialCells(xlCellTypeVisible)

If r.Rows.Count 1 Then
.Range("a1:k7").Copy
Destination:=Worksheets(curVariable).Range("a1")
r.EntireRow.Copy Destination:=Worksheets(curVariable).Range("a2")
End If
.AutoFilterMode = False
End With
End Sub


Regards,
Per

"KT" skrev i meddelelsen
...
Hi all,

Im having a problem with the following code. The purpose is to create
new
sheets from data on OrigSheet for each variable that matches variable
found
on Variablesheet.
Sub DivideThis misses the *first* variable even though I can confirm
in
the immediate window that it exists. All variables are of same type.

The second problem is when I get to Sub copyData, the sub is being
exited
without filtering/copying the data.

Any input much appreciated! :)

Sub divideThis

Dim curVariable As String
Dim i As Integer
Dim lstVariable As Integer
Dim lstrow As Integer

Application.ScreenUpdating = False

With Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" )

lstrow = .Range("b" & Rows.Count).End(xlUp).Row
End With
Debug.Print lstrow

Debug.Print lstVariable

With Workbooks("Myworkbook.Xls").Worksheets("Variablesh eet") ' create a
new
sheet
for each variable

lstVariable = .Range("d" & Rows.Count).End(xlUp).Row ' column D
Debug.Print "last variable" & lstVariable
For i = 2 To lstVariable
curVariable = .Cells(i, 4).Value
curVariableName = .Cells(i, 5).Value
Debug.Print "cur " & curVariable & Cells(i,
4).Address(external:=True)
If Not
Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" ).Range("b2:b" &
lstrow).Find(curVariable) Is Nothing _
Then Call createSheet(curVariable, curVariableName) << DOESNT
FIND
1ST VARIABLE EVEN THOUGH IT IS IN RANGE. DOES FIND THE REST. NEEDS TO
MATCH
*ENTIRE* CELL CONTENTS.

Next i
End With

End Sub

Sub createSheet(curVariable, curVariableName)
Dim newSheet As Worksheet

With Workbooks("Myworkbook.Xls").Worksheets("OrigSheet" ).Activate
On Error Resume Next

Set newSheet = Worksheets.Add
newSheet.Name = curVariable & " " & curVariableName
Call copyData(curVariable)
'On Error GoTo 0
End With
End Sub

Sub copyData(curVariable)
Dim r As Range

With Worksheets("OrigSheet")
lstrow = .Range("b" & Rows.Count).End(xlUp).Row
'MsgBox lstrow
'.AutoFilterMode = False
.Range("a1:k7").Copy Destination:=Worksheets(curVariable).Range("a1")
AS
FAR AS I GET
.Range(.Range("b8"), .Range("b" & .Rows.Count).End(xlUp)) AUTOFILTER
NEEDS
TO START IN ROW 8. PREV ROWS CONTAIN MERGED CELLS
Debug.Print r.Address(external:=True)
If Application.CountIf(r, curVariable) = 0 Then Exit Sub
.Columns("b7:b" & lstrow).AutoFilter Field:=1, Criteria1:=curVariable
Set r = r.SpecialCells(xlCellTypeVisible)
.AutoFilterMode = False
Range("a1:k7").Copy Destination:=Worksheets(curVariable).Range("a1")
r.EntireRow.Copy Destination:=Worksheets(curVariable).Range("a2")
End With
End Sub

--
KT




Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Cells.find only reporting range in AutoFilter... mark Excel Programming 4 October 30th 07 03:29 PM
Error proof way to find first blank Row after Autofilter Range [email protected] Excel Programming 6 July 1st 07 01:42 AM
Excel custom autofilter- how to find wildcard characters but not as wildcards (e.g. "?") in a cell Keith Excel Discussion (Misc queries) 3 December 22nd 06 02:27 PM
Working with AutoFilter, Find , Sort and Ranges Rajesh Excel Programming 0 December 6th 05 12:12 AM
Find out what is selected for AutoFilter Dan Excel Programming 1 July 20th 05 05:21 PM


All times are GMT +1. The time now is 12:02 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright 2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement