I want to use autofilter to delete some rows without selecting the sheet
If the sheet is selected the code runs
If the sheet is not selected the code fails I get the error object required and Set ws = ThisWorkbook.Sheets("LI_Data_Prepped") is highlighted`
the code fails even if I use Select when seting ws
I can not figure out why this is throwing the error possibly because I am using a array for the criteria?
Thanks
Edit: 10-29-14
Sub DeleteSomeNamesIn_LI_Data_Prepped()
Dim ws As Excel.Worksheet
Dim lCol As Long
Dim lRow As Long
Dim cNumber As Integer
'Does NOT work like this
Set ws = ThisWorkbook.Sheets("LI_Data_Prepped").Select
'Does NOT work like this either
Set ws = ThisWorkbook.Sheets("LI_Data_Prepped")
With ws
lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.AutoFilterMode = False
.Range("A1", Cells(lRow, lCol)).Cells.AutoFilter
.Range("A1", Cells(lRow, lCol)).Cells.AutoFilter Field:=2, Criteria1:=Array("Bob", "Carol", "Ted", "Alis", "="), Operator:=xlFilterValues
'If no rows to delete will error
On Error Resume Next
.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilterMode = False
.Range("A1").End(xlDown).Offset(1).Resize(ActiveSheet.UsedRange.Rows.Count).EntireRow.Delete
On Error GoTo 0
End With
End Sub
To avoid pre-selecting the worksheet:
Use Set ws = Worksheets("LI_Data_Prepped") instead of
Set ws = ThisWorkbook.Sheets("LI_Data_Prepped").Select
You can also use Dim ws As Worksheet instead of Dim ws As Excel.Worksheet
Related
I'm trying to run before I can crawl. I have pieced together this code, but I need it to Insert at row 24, not copy.
Dim sh4 As Worksheet, sh5 As Worksheet, lr As Long, rng As Range
Set sh4 = Sheets("est")
Set sh5 = Sheets("gaf letter")
lr = sh4.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh4.Range("a1:a" & lr)
rng.EntireRow.Copy sh5.Rows("24:24")
I've attempted using .Insert, but it comes up with Method Insert of object Range Failed. The code works fine if I wanted to just copy, but I need it to insert and shift the remaining rows below it, down.
Option Explicit ' declare all variables
Sub InsertRows()
Dim sh4 As Worksheet, sh5 As Worksheet
Dim lr As Long, rng As Range
Set sh4 = Sheets("est")
Set sh5 = Sheets("gaf letter")
Application.ScreenUpdating = False
With sh4
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rng = .Rows("1:" & lr)
rng.Copy
sh5.Rows(24).Insert shift:=xlDown
End With
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
just go
With Sheets("est")
.Range("A1", .Cells(.rows.Count, 1).End(xlUp)).EntireRow.Copy
Sheets("gaf letter").rows(24).Insert shift:=xlDown
Application.CutCopyMode = False
End With
I would like to consolidate several sheets by copying data starting from A40 in each sheet
and pasting in a new worksheet
The code doesn't result in error but nothing is copied
Could you help please
Thanks
Sub merge_cognos()
Dim wb As Workbook
Dim ws As Worksheet
Dim startRow As Long
Dim startcol As Integer
Dim lastCol As Long
Dim lastRow As Long
Set wb = ActiveWorkbook
Set ws_new = ActiveWorkbook.Sheets.Add
For Each ws In wb.Worksheets
If ws.Name <> ws_new.Name Then
startRow = 40
startcol = 1
lastRow = Cells(Rows.Count, startcol).End(xlUp).Row
lastCol = Cells(startRow, Columns.Count).End(xlToRight).Column
'get data from each worksheet and copy it into Master sheet
Range(Cells(startcol, startRow), Cells(lastRow, lastCol)).Copy
ws_new.Paste
End If
Next ws
ws_new.Select
With Selection
.Range("F1", Range("F1").End(xlDown)).Sort Key1:=Range("F1"), Order1:=xlDescending, Header:=xlNo
.Columns("F:F").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
End With
End Sub
I revised your code in order to:
avoid use of Select/Selection
reference the proper worksheet at every stage
as follows:
Sub merge_cognos()
Dim wb As Workbook
Dim ws As Worksheet
Dim startRow As Long
Dim startcol As Integer
Dim lastCol As Long
Dim lastRow As Long
Set wb = ActiveWorkbook
Dim ws_new As Worksheet
Set ws_new = wb.Sheets.Add
For Each ws In wb.Worksheets
With ws
If .Name <> ws_new.Name Then
startRow = 40
startcol = 1
lastRow = .Cells(.Rows.Count, startcol).End(xlUp).Row
lastCol = .Cells(startRow, .Columns.Count).End(xlToLeft).Column
'get data from each worksheet and copy it into Master sheet
.Range(.Cells(startRow, startcol), .Cells(lastRow, lastCol)).Copy
With ws_new
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial
End With
End If
End With
Next
With ws_new
.Range("F1", .Range("F1").End(xlDown)).Sort Key1:=.Range("F1"), Order1:=xlDescending, Header:=xlNo
.Columns("F:F").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
Overview:
I have 2 macros, one filters the data and the second deletes the visible rows below the header rows (header rows 1-12).
2 Questions:
1) How do I best combine these into a single macro?
2) How do I get the second one to work properly?
I receive the
Run Time Error 1004: Method 'Range' of object '_worksheet' failed
on the Delete() macro line:
Set rng = .Range("A12:A" & LastRow).SpecialCells(xlCellTypeVisible)
I have also tried:
Set rng = .Range("A12:A" & LastRow).SpecialCells(xlCellTypeVisible).cells
Sub Filter()
'filter and delete rows that have AW as FALSE
For Each sht In ThisWorkbook.Worksheets
sht.Range("A12:AW12").autofilter Field:=49, Criteria1:="FALSE"
Next sht
End Sub
Sub Delete()
Dim sht As Worksheet, rng As Range, lastRow As Long
Set sht = Worksheets("Sheet1")
With sht
lastRow = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A12:A" & LastRow).SpecialCells(xlCellTypeVisible)
rng.EntireRow.Delete
.AutoFilterMode = False
End With
End Sub
Sub Filter()
'filter and delete rows that have AW as FALSE
Dim rng As Range
For Each sht In ThisWorkbook.Worksheets
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
sht.Range("A1:O1").AutoFilter Field:=9, Criteria1:="FALSE"
sht.Range("A2:A" & LastRow).Delete
If sht.AutoFilterMode Then
sht.AutoFilterMode = False
End If
Next sht
End Sub
This is a working code for anyone that might find this going forward.
Sub Filter23()
'filter and delete rows that have AW as FALSE (working)
Dim sht As Worksheet, rng As Range, lastRow As Long
For Each sht In ThisWorkbook.Worksheets
sht.Range("A12:AW12").autofilter Field:=49, Criteria1:="FALSE"
With sht
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set rng = sht.Range("A12:A" & lastRow).SpecialCells(xlCellTypeVisible)
rng.EntireRow.Delete
End With
Next sht
End Sub
I have this code, by a responder who helped me to define my needs yesterday - but there somethings i want to change, but my vba skills are very low and dont know how and where to modify the code. I want it do 2 Things.
Right know it transferes data, i want it to copy it, over with the values that are calculated in the cells. I have some cells, where i have some formulas and it dosent follows with it. I just want the calculated value over. I dont know if i can use xlPasteValues somewhere to get what i want?
The second thing that i want is, when copying over, i want to be on top and the previous copies move Down, so the latest copy always are in the top.
Thank you before handed :)
Option Explicit
Sub Copypastemeddata()
Dim wb As Workbook
Dim ws As Worksheet
Dim sourceCell As Range
Dim targetSheet As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Opgørsel")
Set sourceCell = ws.Range("D3") 'Cell with sheet names for copying to
With ws
Set targetSheet = wb.Worksheets(sourceCell.Text)
Dim nextRow As Long
nextRow = GetLastRow(targetSheet, 1)
nextRow = IIf(nextRow = 1, 1, nextRow + 1)
.Range("A1").CurrentRegion.Copy targetSheet.Range("A" & nextRow)
targetSheet.Columns.AutoFit
End With
End Sub
Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
With ws
GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
End With
End Function
Please give this a try...
The StartRow variable defines the destination row on targetSheet, you may change it as per your requirement.
Sub Copypastemeddata()
Dim wb As Workbook
Dim ws As Worksheet
Dim sourceCell As Range
Dim targetSheet As Worksheet
Dim StartRow As Integer
Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Opgørsel")
Set sourceCell = ws.Range("D3") 'Cell with sheet names for copying to
StartRow = 1 'Destination row on targetSheet
With ws
Set targetSheet = wb.Worksheets(sourceCell.Text)
.Range("A1").CurrentRegion.Copy
targetSheet.Range("A" & StartRow).Insert shift:=xlDown
targetSheet.Range("A" & StartRow).PasteSpecial xlPasteValues
targetSheet.Columns.AutoFit
End With
Application.CutCopyMode = 0
Application.ScreenUpdating = True
End Sub
substitute
Dim nextRow As Long
nextRow = GetLastRow(targetSheet, 1)
nextRow = IIf(nextRow = 1, 1, nextRow + 1)
.Range("A1").CurrentRegion.Copy targetSheet.Range("A" & nextRow)
with
With .Range("A1").CurrentRegion
targetSheet.Rows(1).Resize(.Rows.Count).Insert shift:=xlUp
targetSheet.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
I need a macro that need to filter a column and to take out the required date value along with the cell position (i.e say "4/22/2018" cell position "A9 or just 9"). Kindly help me out to fix this issue
See the code that I wrote below
Dim Date As String
Date = Sheets("alldata")
Rows("3:3").Select.AutoFilter.Range("$A$3:$AA$606").AutoFilter , Field:=1, Criterial:="#VALUE!"
Range("A3").Select.xlFilterValues.offset(1, 0).Copy.value
Sheets("Log").Cells(2, "AF").value = Date
Is this what you are trying?
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
Set ws = Sheets("alldata")
With ws
Set rng = .Range("$A$3:$A$606")
'~~> Remove any filters
.AutoFilterMode = False
With rng
.AutoFilter Field:=1, Criteria1:="<>#VALUE!"
'~~> Get the Row Number
MsgBox .Offset(1, 0).SpecialCells(xlCellTypeVisible).Row
'~~> Get The cell Address
MsgBox .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1).Address
'~~> Get the Date
Sheets("Log").Cells(2, "AF").Value = _
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1).Value
End With
'~~> Remove any filters
.AutoFilterMode = False
End With
End Sub
The following will filter the dates and for each date it will copy the value into Sheet Log in Column AF:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("alldata")
Dim wsLog As Worksheet: Set wsLog = Sheets("Log")
'declare and set your worksheet, amend as required
Dim LastRow As Long, LogLastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
Dim c As Range, rng As Range
ws.Rows("3:3").AutoFilter
ws.Range("$A$3:$AA$" & LastRow).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(0, "01/01/2018")
Set rng = ws.Range("$A$4:$A$" & LastRow).SpecialCells(xlCellTypeVisible)
For Each c In rng
LogLastRow = wsLog.Cells(wsLog.Rows.Count, "AF").End(xlUp).Row
c.Copy Destination:=wsLog.Cells(LogLastRow, "AF")
'if instead of copying the value, you want to return its address,
'you can get the address by using "c.Address" for each value in the range
Next c
End Sub