I am trying to design a macro that will simply turn off the filtering on a certain workbook. I have begun to write the code but for some reason on the first line under the comment it causes an Application or Object defined error. I am really confused why this is happening. I have posted the code below. Any help would be greatly appreciated.
Sub crossUpdate()
Dim rng1 As Range, rng2 As Range, rng1Row As Range, rng2Row As Range, Key As Range, match As Integer
Workbooks("011 High Level Task List v2.xlsm").Activate
'Unhide and Unfilter columns and rows on original sheet
With Sheets("Development Priority List").Cells
.EntireColumn.Hidden = False
.EntireRow.Hidden = False
.AutoFilter
End With
With ActiveSheet
.AutoFilterMode = False
.Cells.EntireRow.Hidden = False
.Cells.EntireColumn.Hidden = False
End With
Try this and amend the code lines following similarly:
ActiveWorkbook.Sheets("Sheet3").Cells.EntireColumn.Hidden = False
To save yourself some typing you could also consider:
With ActiveWorkbook.Sheets("Sheet3").Cells
.EntireColumn.Hidden = False
.EntireRow.Hidden = False
.AutoFilter
End With
Related
I've been working on a VBA macro to copy data that matches certain criteria from one worksheet to another worksheet without altering the original worksheet.
I'm locating the last row from worksheet "Prospects" and selecting the criteria that I need and it copies over to the other worksheet "Results", but both worksheets look identical.
So any rows that don't meet the filter criteria are removed from the original worksheet "Prospects".
I need the original worksheet to remain unaltered. I'm also just capturing certain columns, thus hiding the columns that I don't need on the "Results" worksheet.
Sub ProspectList()
Dim r As Range
Dim ws As Worksheet
Set ws = ActiveSheet
ws.Range("A1").AutoFilter
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
LastCol = ActiveSheet.Cells(1, Columns.Count).End(xlUp).Column
With Sheets("Prospect List").Range([A2], [A2].SpecialCells(xlCellTypeLastCell))
ws.Range("A1").AutoFilter field:=13, Criteria1:="Pipeline"
[B:B].EntireColumn.Hidden = True
.Copy
[C:C].EntireColumn.Hidden = True
.Copy
[E:E].EntireColumn.Hidden = True
.Copy
[H:H].EntireColumn.Hidden = True
.Copy
[I:I].EntireColumn.Hidden = True
.Copy
[K:K].EntireColumn.Hidden = True
.Copy
[L:L].EntireColumn.Hidden = True
.Copy
[B:B].EntireColumn.Hidden = False
[C:C].EntireColumn.Hidden = False
[E:E].EntireColumn.Hidden = False
[H:H].EntireColumn.Hidden = False
[I:I].EntireColumn.Hidden = False
[K:K].EntireColumn.Hidden = False
[L:L].EntireColumn.Hidden = False
End With
With Sheets("Results")
If .Cells(Sheets(1).Rows.Count, 1).End(xlUp) = "" Then 'it's a clean sheet
.Cells(Sheets(1).Rows.Count, 1).End(xlUp).PasteSpecial Paste:=xlPasteValues
Else
.Cells(Sheets(1).Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
End With
Application.CutCopyMode = False
End Sub
First: Your title is confusing; do you want to filter the data on worksheet "Prospects", copy the visible data, and move it to the "Results" worksheet?
Second: you "Dim r As Range" but you don't use it in your code.
Third: you Don't Dim "LastRow" and "LastCol" and don't even use them in your code.
Forth: Why are you filter "column A" then "filter Column M" before you hide the specific columns and u-nhide them?
Fifth: your "LastCol" code is wrong
Six: You hide and un-hide the columns for no apparent reason.
Seventh: your "With code" does not make any sense, you are testing "sheet1", not copying anything and then pasting on "sheet1" not the "Results" sheet. which worksheet is "Sheets(1)"?
I would suggest that you filter your data on the "Prospects" worksheet select the visible data using .SpecialCells(xlCellTypeVisible).Copy then paste to the "Results" worksheet
This is what I ended up doing.
Sub ProspectList()
Dim ws As Worksheet
Dim LastRow As Long
Set ws = ActiveSheet
'Find last row and copy complete sheet to new sheet
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).row
Sheets("Prospects").Range("A1:M" & LastRow).Copy Destination:=Sheets("Results").Range("A1")
'set the new "Results" sheet to active
Worksheets("Results").Activate
'filter by criteria and hide columns not needed
With Sheets("Results")
ws.Range("A1").AutoFilter Field:=13, Criteria1:="Pipeline"
[B:B].EntireColumn.Hidden = True
[C:C].EntireColumn.Hidden = True
[E:E].EntireColumn.Hidden = True
[H:H].EntireColumn.Hidden = True
[I:I].EntireColumn.Hidden = True
[K:K].EntireColumn.Hidden = True
[L:L].EntireColumn.Hidden = True
[M:M].EntireColumn.Hidden = True
End With
Application.CutCopyMode = False
End Sub
I've been tasked with removing duplicates from a dataset, but in a specific way; I need to apply a filter with two criteria, then remove all visible rows except the first one, which I will be editted on the fly.
I'm sure the solution rests with a loop filtering each criteria and deleting the relevant rows. However, I'm not sure how to go about it. Using offset is no good; setting and offsetting a range from used & visible cells doesn't seem to work; it always offsets from row 1, not the visible rows.
The range Dive is from the sheet WS, not the "Compilation Sheet" where the autofilter and duplication removal is taking place.
Sub Dupe_killer()
Dim List As Worksheet
Dim Dive As Range
Dim Hit As Range
Set List = Sheets.Add
Dim aRow As Range
Dim fRow As Range
Dim lRow As Range
Dim r As Range
Dim Rng As Range
Dim FilterRange As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
Worksheets("Compilation Sheet").Activate
If ActiveSheet.FilterMode = False Then
ActiveSheet.Range("A1:bc1").AutoFilter
End If
ActiveWorkbook.Worksheets("Compilation Sheet").AutoFilter.Sort.SortFields.Clear
ActiveSheet.Range("$A$1:$BC$11188").AutoFilter Field:=2, Criteria1:=RGB(255 _
, 0, 255), Operator:=xlFilterCellColor
List.Range("A:A").Value = Worksheets("Compilation Sheet").Range("B:B").Value
List.Range("A:A").RemoveDuplicates Columns:=Array(1)
Set r = List.Range("A2")
Set Dive = Range(r, r.End(xlDown))
For Each Hit In Dive
With Worksheets("Compilation Sheet")
.Range("A1:BC1").AutoFilter Field:=2, Criteria1:=Hit
.Range("A1:BC1").AutoFilter Field:=10, Criteria1:="*", Criteria2:="*,*", Operator:=xlAnd
End With
Set FilterRange = ActiveSheet.UsedRange.Offset(2, 0) _
.SpecialCells(xlCellTypeVisible)
FilterRange.Select
Next Hit
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
End With
End Sub
You want to set the range in Dive to be only the visible rows.
Google the syntax for
.SpecialCells(xlCellTypeVisible)
I think i've cracked it. Found a nifty bit of code for selecting the first visible cell. I could then hide that row and delete all visible.
Range("A2", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Select
ActiveCell.EntireRow.Hidden = True
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Delete
I am working on a macro that will update an excel spreadsheet from another sheets information. But, when updating I want to move two columns to the front because I don't want them to change. Everything works up to the point where I move the two columns to the front. I select them, cut them and paste them but for some reason right after the paste happens it throws an error saying the paste had failed (error 1004-PasteSpecial method of Range class failed). I am very confused on why this is happening and any help would be greatly appreciated.
Sub crossUpdate()
Dim rng1 As Range, rng2 As Range, rng1Row As Range, rng2Row As Range, Key As Range, match As Integer
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = Workbooks("011 High Level Task List v2.xlsm")
Set wb2 = Workbooks("011 High Level Task List v2 ESI.xlsm")
'Unfilter and Unhide both sheets
With wb1.Sheets("Development Priority List")
.Cells.EntireColumn.Hidden = False
.Cells.EntireRow.Hidden = False
.AutoFilterMode = False
End With
With wb2.Sheets("Development Priority List")
.Cells.EntireColumn.Hidden = False
.Cells.EntireRow.Hidden = False
.AutoFilterMode = False
End With
'Copy and paste original sheet to new temp sheet
wb1.Sheets("Development Priority List").Activate
wb1.Sheets("Development Priority List").Cells.Select
Selection.Copy
Sheets.Add.Name = "SourceData"
wb1.Sheets("SourceData").Paste
'Sort temp sheet by key
N = Cells(Rows.Count, "A").End(xlUp).Row
Set rng1 = wb1.Sheets("SourceData").Cells.Range("A2:A" & N)
Set rng1Row = rng1.EntireRow
rng1Row.Sort Key1:=Sheets("SourceData").Range("A1")
'Update sheet sorted by key
N = Cells(Rows.Count, "A").End(xlUp).Row
Set rng2 = wb2.Sheets("Development Priority List").Cells.Range("A2:A" & N)
Set rng2Row = rng2.EntireRow
rng2Row.Sort Key1:=wb2.Sheets("Development Priority List").Range("A1")
'Dev columns moved on update sheet
With wb2.Sheets("Development Priority List")
.Columns("F:G").Cut
.Columns("A:B").Insert Shift:=xlToRight
.Activate
.Columns("A:B").Select
End With
Selection.PasteSpecial <------ Line that throws error
End Sub
Change your block of code as such:
With wb2.Sheets("Development Priority List")
.Columns("A:B").Insert Shift:=xlToRight
.Columns("H:I").Cut
.Range("A1").PasteSpecial
End With
I know this is a pretty basic question, but im still working on building my VBA skills. I am in a predicament where I have made a mapping system of various reports I receive that get placed in a compiled workbook. These reports have entirely different formats etc. I have a copy/paste macro that copies columns and places them in their correct position on the compiled workbook.
I've come into situations however where there are a lot of duplicate / empty rows that screw up my Macro. I have used two VBA functions to solve this, one is a "delete row if reference column is blank":
Sub DeleteBlankARows()
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
Dim r As Long
For r = Cells(Rows.Count, 6).End(xlUp).Row To 1 Step -1
If Cells(r, 6) = "" Then Rows(r).Delete
Next r
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With End Sub
This deletes rows where cells in column F are empty
I also use a copy/paste down macro:
Sub CopyUntilBlank()
Dim last_row As Integer
last_row = Range("f1").End(xlDown).Row
Dim rng As Range
Set rng = Range("d2:d" & last_row)
For Each cell In rng.Cells
cell.Activate
If ActiveCell.Value = "" Then
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
End If
Next cell End Sub
This copies and pastes down blank rows in column D until you hit a non-blank cell then re-does this until the range of values in column F.
These macros work well for me, but because I have multiple sheets like this, I would like to create a cell references that make the ranges dynamic. For instance: in the DeleteBlankRows macro, I would like to have the column reference in Cells(r,6) be determined off of a cell value in sheet1 - so for instance if the value in cell A1 on sheet 1 is 2 it would change the column reference to "2" (column B).
I would like the same to happen for the copy/paste down macro. I'm pretty sure this is just some reference to A1.Value but I don't know how to properly write such thing.
Thank you for your support, I've gone quite a long way with all the support of the community.
An example using your first sub:
Sub DeleteBlankARows(colIndex as Long)
Dim colIndex as long
colIndex = Sheet1.Range("a1").value
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
Dim r As Long
For r = Cells(Rows.Count, colIndex).End(xlUp).Row To 1 Step -1
If Cells(r, colIndex) = "" Then Rows(r).Delete
Next r
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
It's not clear from your question which column in the second sub needs to be dynamic (or both of them?)
EDIT try this:
Sub CopyUntilBlank()
Dim last_row As Long, col1 as Long, col2 as Long
Dim rng as Range
col1 = Sheet1.Range("a2").value
col2 = Sheet1.Range("a3").value
last_row = Cells(1, col1).End(xlDown).Row
'This next line is better if there's any chance
' of blanks in this column
'last_row = Cells(Rows.Count, col1).End(xlUp).Row
With ActiveSheet
Set rng = .Range(.Cells(2, col2), .Cells(last_row, col2))
End With
For Each cell In rng.Cells
If cell.Value = "" Then
cell.Value = cell.Offset(-1, 0).Value
End If
Next cell
End Sub
How do I store and retrieve the row numbers returned from an AutoFilter action using VBA? For example, I used #brettdj code from this question (see code below) to delete all rows with "X" under column B. Now I need to store the row numbers with X (B4,B6,B9 - see screen shots below) because I need to delete the same rows on other sheets in the same workbook.
Sub QuickCull()
Dim ws As Worksheet
Dim rng1 As Range
Set ws = Sheets("Sheet1")
Set rng1 = ws.Range(ws.[b2], ws.Cells(Rows.Count, "B").End(xlUp))
Application.ScreenUpdating = False
With ActiveSheet
.AutoFilterMode = False
rng1.AutoFilter Field:=1, Criteria1:="X"
rng1.Offset(1, 0).EntireRow.Delete
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub
Using the code from Is it possible to fill an array with row numbers which match a certain criteria without looping? you could return these rows quickly without the AutoFilter
For example, this code will return a range of rows where X is found within B2:B50000
Sub GetEm()
Dim StrRng As String
StrRng = Join(Filter(Application.Transpose(Application.Evaluate("=IF(B2:B50000=""X"",""B""&ROW(B2:B50000),""X"")")), "X", False), ",")
If Len(StrRng) > 0 Then MsgBox Range(StrRng).EntireRow.Address & " could be deleted elsewhere"
End Sub