I have a table that I need to autofilter itself according to criteria in column "AS", then copy multiple discrete columns' worth of resulting non-blank cells to specific cells in the next sheet.
What is the most efficient way of doing this? I'm aware that I may have to copy/paste specialvalues instead of direct reference
I'm not entirely sure what you're asking. But, imagine Column A is filled with names of fruits and Column B is filled with numbers. The following code filters Column A with the criteria "Apples" and copies the corresponding numbers to a new worksheet. This might start you off on the right track.
Sub selectApples()
' Find last row in column A
Dim LastRow As Integer
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
' Select data in column A and filter
Range("A1:A" & LastRow).Select
Selection.AutoFilter Field:=1, Criteria1:="Apples"
'Find new last row
Dim newLastRow As Integer
newLastRow = Cells(Rows.Count, 1).End(xlUp).Row
'Copy and paste special into new worksheet
Range("B2:B" & newLastRow).Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValues
End Sub
Related
I am trying to put a condition on each row copied. I want all uniques but only if they also have a specific value in another field.
This is what I have to grab all uniques (and it works) but I can't figure out how to get only the rows with a specific value in column J.
r1.Columns(20).AdvancedFilter xlFilterCopy, , Sheet11.Range("A1"), unique:=True
I have tried doing a CriteriaRange but I can't seem to get the syntax correct for it. Additionally I thought about an If statement but logically in my head it means it would fire off the whole list every time it has a true statement, not on a per row basis.
Here is how I thought it might work. But I get a type mismatch error.
r1.Columns(20).AdvancedFilter xlFilterCopy, r1.Columns(10).Value = "November", Sheet11.Range("A1"), unique:=True
Thoughts?
First of all, your Criteria Range should be just that - a Range with the header corresponding to the column to be filtered, and criteria underneath. For example, D1:D2 in this snapshot:
Secondly, you won't be able to copy just a single column (20) while filtering another column (10) in the same step.
You can tweak the Advanced Filter to
First filter the entire list in place based on the criterion provided
And then copy the visible cells in the column in question
Something like this (change Sheet and Range references as needed):
Sub MyFilter()
Dim lastRow As Long
With Sheet1
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A1:B" & lastRow).AdvancedFilter _
Action:=xlFilterInPlace, CriteriaRange:=.Range("D1:D2"), Unique:=True
With .Range("B1:B" & lastRow).SpecialCells(xlCellTypeVisible)
.Copy Sheet2.Range("A1")
End With
.ShowAllData
End With
End Sub
To be able to keep the other parts of the code that worked perfectly. I added a hidden sheet and wrote a macro to copy the filtered results out to the new hidden sheet. Then I ran my original code against the filtered data on that hidden sheet.
Sub FilterLiveToDataSheet()
' Unhide Required Sheets
Sheets("Original-Data").Visible = True
Sheets("Filtered-Data").Visible = True
' Delete Old Data
Sheets("Filtered-Data").Select
Cells.Select
Selection.ClearContents
' Copy Filtered Data
Sheets("Original-Data").Select
Range("TBL_ATTR_Spend[[#Headers],[HeaderName]]").Select
Selection.AutoFilter
ActiveSheet.ListObjects("TBL_ATTR_Spend").Range.AutoFilter Field:=10, _
Criteria1:="Delta"
Cells.Select
Selection.Copy
' Paste to Data Sheet
Sheets("Filtered-Data").Select
Cells.Select
ActiveSheet.Paste
' Unfilter Original Data Page
Sheets("Original-Data").Select
Range("TBL_ATTR_Spend[[#Headers],[HeaderName]]").Select
Selection.AutoFilter
' Hide Required Sheets
Sheets("Original-Data").Visible = False
Sheets("Filtered-Data").Visible = False
' Go to Results Sheet
Sheets("Results").Select
I'm a beginner so bear with me
The code I'm using now is this, given to me by user "Xabier", slightly edited by me. This copies the rows with a certain document# into a separate sheet, thus giving me a list:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("inbd")
Dim wsDestination As Worksheet: Set wsDestination = Sheets("test")
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ws.Range("A1:N" & LastRow).AutoFilter Field:=1, Criteria1:=Worksheets("test").Cells(1, 26).Value
ws.Range("A2:N2" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestinationRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
wsDestination.Range("A" & DestinationRow).PasteSpecial xlPasteValues
Application.CutCopyMode = False
ws.Range("A1:N" & LastRow).AutoFilter Field:=1
End Sub
Now what I want to do is create something like a header for the document containing data regarding the origin of the imports.
This data is the "Import#", "Invoice#", "Supplier" and "Invoice date". Basically for every unique Invoice# I need to create a unique entry even if the supplier or the import# is the same.
And I can't copy the entire row, I just need to copy certain cells in each row.
After I actually figure out how all this works, this is how the document is going to look.
this is actually a pretty involved solution that StackOverflow is not meant for. Instead, i'll give you an idea of how you could implement this yourself.
loop through filtered data
if not first loop, check if the previous new sheet's invoice number matches this one
check that new sheet is not too full to add invoice
copy this row's invoice information to new sheet
looping through filtered data
copying data from cell to cell
I am trying to insert a column into the sheet and copying the formulas into it from the adjacent column to the right.
The place to insert the column is being read from the work sheet itself. E.G Column S (Column 19).
So I need to insert a new Column at Column "S" and copy the formulas from the "Old" Column S, now Column T.
I am using the following code but it is giving me 1004 error.
Sub Insert_Rows_Loop()
Dim CurrentSheet As Object
'MsgBox "ghj" & Sheet16.Range("H2").Value
Sheet2.Cells(1, Sheet16.Range("H2").Value).EntireColumn.Select
Selection.Copy
Selection.Insert Shift:=xlToLeft
Application.CutCopyMode = False
Sheet2.Cells(1, Sheet16.Range("G2").Value).EntireColumn.Select
Selection.Copy
Selection.Insert Shift:=xlToLeft
Application.CutCopyMode = False
Sheet2.Cells(1, Sheet16.Range("F2").Value).EntireColumn.Select
Selection.Copy
Selection.Insert Shift:=xlToLeft
Application.CutCopyMode = False
End Sub
The code below will do the following:
Insert a new Column to the left of current Column S
Set the Formulas in Column S to the Formulas in Column T (Old Column S) to Column S
Dim CurrentSheet As Worksheet
Set CurrentSheet = ThisWorkbook.Sheets("Sheet1")
With CurrentSheet
'Inserting the Column before Column S
.Range("S1").EntireColumn.Insert
'Copying the Formulas from the T(Old S) to S
.Range("S1").EntireColumn.Formula = .Range("T1").EntireColumn.Formula
End With
You need to adjust the value in the Range to suit your requirement and you Sheet Referencing will be different.
I hope you get the idea behind it.
Your sample code is indicative of the problems that are encountered when relying upon .Select and .Activate methods to navigate and reference various cells and worksheets in a workbook. Avoid .Select and .Activate in favor of direct cell referencing¹.
The second issue is no predetermined order for the column insertion. While you can insert columns in a seemingly random order, if there is an ascending pattern to the column numbers the latter columns will change position when a column is previously inserted to the right of it. The 'best practise' is to insert the columns starting at the right and working toward column A.
The following has been based on what your sample code said as it does not follow the same flow as your narrative.
Sub Insert_Rows_Loop()
Dim c As Long, arr As Variant
With Sheet16
ReDim arr(2)
'get them in descending order so that inserting 1 does not change the position of 2 or 3
arr(0) = Application.Large(.Range("F2:H2"), 1)
arr(1) = Application.Large(.Range("F2:H2"), 2)
arr(2) = Application.Large(.Range("F2:H2"), 3)
End With
With Sheet2
For c = LBound(arr) To UBound(arr)
With .Columns(arr(c))
.Copy
.Insert Shift:=xlToLeft
End With
Next c
End With
Application.CutCopyMode = False
End Sub
¹ See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.
I have a sheet with a specific number columns. I need to copy columns A and another column starting with column B, create a new sheet and paste those columns there. I then want to loop it so that it copies columns A and C this time, then create a new sheet and paste, and so forth until it reaches the last column on the main sheet. Column A is fixed so that it is always copied, the second column copied is the one that varies. I'm thinking something like this inside the loop
Sheets(1).Activate
Range("A1:A14").Select
'This is where I need to copy the next column over and increment every time the code loops
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Help would be appreciated. Thank You.
Your best bet is to use Cells() inside of your Range() in order to loop through each column. This bit of code should help you out:
Sub columnCopy()
Dim sh1 As Worksheet
Set sh1 = sheets("Sheet1")
lc = sh1.Cells(1, Columns.Count).End(xlToLeft).Column ' Last Column
For i = 2 To lc
sh1.Range(sh1.Cells(1, 1), sh1.Cells(12, 1)).Copy
Worksheets.Add
sheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteValues
sh1.Range(sh1.Cells(1, i), sh1.Cells(12, i)).Copy
sheets(1).Cells(1, 2).PasteSpecial Paste:=xlPasteValues
Next i
End Sub
[This is in Excel 2007]
In other words, the loop will cycle through all the active cells in a one-column range (rngAddressName) and, if the cell in the range AND the cell directly to the left of it contain the string "#N/A", then it will delete that row.
Unfortunately, nothing I have tried has had any actual effect. Here is my best go at it:
i = 1
For counter = 1 To rngSC2A.Rows.Count
Contents = rngSC2A.Cells(i).Value
If Contents = "#N/A" Then
If rngAddressName.Cells(i).CellOffset(0, -1).Value = "#N/A" Then
rngAddressName.Cells(i).EntireRow.Delete
Else
End If
Else
i = i + 1
End If
Next
But this doesn't seem to find any rows with the conditions satisfied (even though such rows exist in the worksheet).
I think it might have something to do with the fact that I am looking in the Cell.Value, but I am not sure.
You can autofilter your range, delete any rows that meet your criteria, then turn the autofilter off. This is a much more efficient approach than looping.
The example below works on columns A and B in Sheet1. Modify the variables to reference the range and sheet in your workbook.
Sub DeleteDoubleNA()
Dim ws As Worksheet
Dim rng As Range
Dim lastRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
lastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set rng = ws.Range("A1:B" & lastRow)
' filter and delete all but header row
With rng
.AutoFilter field:=1, Criteria1:="#N/A"
.AutoFilter field:=2, Criteria1:="#N/A"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
' turn off the filters
ws.AutoFilterMode = False
End Sub
This is a different take on on the excellent answer posted by #Jon Crowell.
If you use an Excel table, you can use the table's ListObject to get the data range which automatically excludes the header and footer rows.
This avoids the sometimes incorrect calculation search for a last row.
You also want to clear any pre-existing filters on the data so that you don't overlook any rows.
Dim myTable As Object
Set myTable = ActiveSheet.ListObjects(1) ' Works if worksheet contains only one table
' Clear pre-existing filters on the table
myTable.AutoFilter.ShowAllData
' Filter the table
With myTable.DataBodyRange
.AutoFilter field:=1, Criteria1:="#N/A"
.AutoFilter field:=2, Criteria1:="#N/A"
End With
' Delete visible cells in the filtered table
myTable.DataBodyRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete
' Clear filters on the table
myTable.AutoFilter.ShowAllData
The (1) in ListObjects(1) is the first (in my case only) table in the worksheet. DataBodyRange refers to the data range of that table excluding header and footer rows.