Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete all rows except those meeting criterias
Headers on row 1.
Data in A:AD Criteria in column B. Delete rows if the value in row B does not equal "Apples" or "oranges" Then create sheets based on value in A, and copy the data onto each sheet based on the data in A and the name of sheet. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete all rows except those meeting criterias
This will delete the rows for you. Hope this helps! If so, let me know,
click "YES" below. Sub DeleteRows() Dim LastRow As Long Dim rw As Long Application.ScreenUpdating = False LastRow = Cells(Rows.Count, "B").End(xlUp).Row For rw = LastRow To 2 Step -1 If Cells(rw, "B").Value < "Apples" Or Cells(rw, "B").Value < "Oranges" Then Rows(rw).Delete Shift:=xlUp End If Next rw Application.ScreenUpdating = True End Sub You are vague on the criteria for the second part. Please explain in further detail. -- Cheers, Ryan "J.W. Aldridge" wrote: Headers on row 1. Data in A:AD Criteria in column B. Delete rows if the value in row B does not equal "Apples" or "oranges" Then create sheets based on value in A, and copy the data onto each sheet based on the data in A and the name of sheet. . |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete all rows except those meeting criterias
Hi Jeremy, Not sure what this means.
Then create sheets based on value in A, and copy the data onto each sheet based on the data in A and the name of sheet. "J.W. Aldridge" wrote in message ... Headers on row 1. Data in A:AD Criteria in column B. Delete rows if the value in row B does not equal "Apples" or "oranges" Then create sheets based on value in A, and copy the data onto each sheet based on the data in A and the name of sheet. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete all rows except those meeting criterias
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete all rows except those meeting criterias
Are you sure that the variable "CurrentCellValue" equates to a worksheet
name or index number? It looks like it worked earlier where you used the variable "Testwksht". "J.W. Aldridge" wrote in message ... 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Deleting rows meeting certain criteria in a particular column | Excel Discussion (Misc queries) | |||
Code to delete columns meeting a condition | Excel Discussion (Misc queries) | |||
Delete rows based on multiple criterias | Excel Discussion (Misc queries) | |||
copy rows meeting criteria to another worksheet | Excel Worksheet Functions | |||
Delete Row meeting a Criteria | Excel Programming |