View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Ryan H Ryan H is offline
external usenet poster
 
Posts: 489
Default delete all rows except those meeting criterias

Ok, I think I understand what you are trying to do. You are trying to scan
each cell in Col.A in Sheet("ERRORS"), which is your "source". And within
each cell is a sheet name. You want to find that sheet within the workbook
and then paste that cells entire row in the sheet that was found. If the
sheet is not in the workbook, you want to create a new sheet before
Sheets("TA_END") and copy that cells row to it. Am I right?

If so, I took the liberty to rewrite your code. I wouldn't recommend you
using On Error Resume Next because it can cause a lot of problems when trying
to debug code. I tested this code and it worked for me. Hope this helps!
If so, let me know, click "YES" below.

Option Explicit

Sub Create_Sheets_From_Data()

Dim LastRow As Long
Dim rngSource As Range
Dim rng As Range
Dim wks As Worksheet
Dim bolSheetExists As Boolean

Application.ScreenUpdating = False

' set range of cells to loop thru in source worksheet
With Sheets("ERRORS")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set rngSource = .Range("A1:A" & LastRow)
End With

' loop thru each cell in Source range
For Each rng In rngSource

' test if worksheet exists
For Each wks In Sheets
If rng.Value = wks.Name Then
bolSheetExists = True
Exit For
End If
Next wks

If bolSheetExists Then
' if sheet exists find lastrow and copy rng source row
LastRow = wks.Cells(Rows.Count, "A").End(xlUp).Row
rng.EntireRow.Copy Destination:=wks.Range("A" & LastRow + 1)
Else
' if sheet doesn't exist, create sheet and copy rng source row
Worksheets.Add(Befo=Sheets("TA_END")).Name = rng.Value
rng.EntireRow.Copy Destination:=Sheets(rng.Value).Range("A1")
End If
bolSheetExists = False
Next rng

Application.ScreenUpdating = True

End Sub

--
Cheers,
Ryan


"J.W. Aldridge" wrote:

This is what i meant...
Create sheets based on value in column A.
Transfer data to each created sheet based on names in column A.

Tried adapting to what i need, but getting error on

Set Targetsht = ActiveWorkbook.Worksheets(CurrentCellValue)


Sub Create_sheets_from_data()
'copy rows to worksheets based on value in column A
'assume the worksheet name to paste to is the value in Col A
Dim CurrentCell As Range
Dim SourceRow As Range
Dim Targetsht As Worksheet
Dim TargetRow As Long
Dim CurrentCellValue As String


'start with cell A1 on Sheet1
Set CurrentCell = Worksheets("ERRORS").Cells(1, 1) 'row 1 column 1


Do While Not IsEmpty(CurrentCell)
CurrentCellValue = CurrentCell.Value
Set SourceRow = CurrentCell.EntireRow


'Check if worksheet exists
On Error Resume Next
Testwksht = Worksheets(CurrentCellValue).Name
If Err.Number = 0 Then
'MsgBox CurrentCellValue & " worksheet Exists"
Else
'TO INSERT SHEETS BEFORE A SPECIFIED SHEET, CHANGE NAME
BELOW(END)
'Worksheets.Add(befo=Sheets("TA_END")).Name =
CurrentCellValue
End If


On Error GoTo 0 'reset on error to trap errors again


Set Targetsht = ActiveWorkbook.Worksheets(CurrentCellValue)
'note: using CurrentCell.value gave me an error if the value was
numeric


' Find next blank row in Targetsht - check using Column A
TargetRow = Targetsht.Cells(Rows.Count, 1).End(xlUp).Row + 1
SourceRow.Copy Destination:=Targetsht.Cells(TargetRow, 1)


'do the next cell
Set CurrentCell = CurrentCell.Offset(1, 0)
Loop
End Sub

.