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
|