I have written a code to loop though range of cells and copy certain data in a column. But everytime I run the code it just copies the last record and not all of them. The issue is somewhere in the destination line of code where it can't find the last unused cell. Any help will be very appreciated. Many Thanks.
Sub ImmoScout()
Dim MyRange As Range, Mycell As Range, Mycell2 As String
Set MyRange = Application.Selection
'Application.ScreenUpdating = False
For Each Mycell In MyRange
Mycell2 = Mycell.Value
Worksheets("Sheet1").Activate
Worksheets("Sheet1").AutoFilterMode = False
Range("A1:BB34470").AutoFilter Field:=54, Criteria1:=Mycell2
Range("AM1").Select
Range(Selection, Selection.End(xlDown)).Select
If Selection.Cells.Count < 1048576 Then
Selection.Copy Destination:=Range("BP1048576").End(xlUp).Offset(1, 0)
Range("AU1").Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy Destination:=Range("BQ1048576").End(xlUp).Offset(1, 0)
End If
Next Mycell
' Application.ScreenUpdating = True
End Sub
You could use advanced filter:
Sheets("Emps").Range("A1:D8").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Emps").Range("F5:F6"), CopyToRange:=Range("A1:B1"), _
Unique:=False
Data source to selectively copy:
Data destination copied:
Reference this short YouTube video; You can record a marco to help yourself with the code also:
https://www.youtube.com/watch?v=bGUKjXmEi2E
A more thorough tutorial is found here:
http://www.contextures.com/xladvfilter01.html
This tutorial shows how to get the source data from outside Excel:
https://www.extendoffice.com/documents/excel/4189-excel-dynamic-filter-to-new-sheet.html
This tutorial shows how to split data values based on a column to different sheets (Fruit column; Apple sheet, Pear sheet, etc.):
https://www.extendoffice.com/documents/excel/2884-excel-save-filtered-data-new-sheet-workbook.html
Side note: your criteria needs the titles you are querying on just like the output needs the titles to know where to place the info. If it doesn't match correctly, Excel won't know what you mean. Don't forget to update the range name!
Before version:
After version:
Your code in this case is:
Sub yourFilter()
Range("Source").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Sheet2!Criteria"), CopyToRange:=Range("Sheet1!Extract"), Unique:=False
End Sub
Avoid using Select and Activate which is not required when Autofiltering or copying a range. Instead declare some range variable, set it properly and use it.
After you have applied autofilter, maybe you are interested in copying the visible cells. Change the lines which are copying the ranges as below...
Range("AM1:AM34470").SpecialCells(xlCellTypeVisible).Copy
Range("AU1:AU34470").SpecialCells(xlCellTypeVisible).Copy
Also Selection.End(xlDown) is not very reliable, it will stop once it finds an empty cell if any before the last cell in the column.
Related
I just started working with large quantities of data from Azure and other software products that produce CSVs or excel files that produce information formatted as follows:
Is there an easy way to format it like:
So that it can be used effectively as a table?
Thank you!
Here's an algorithmic approach that you can implement in VBA
Get references to the Sheet and Range containig the data
Copy the Data to a Variant Array variable
Loop throught the Data Array rows
For each row that column A is Not Empty, capture the value
For each row where Column B is Empty, clear Column A
For each row where Column B is Not Empty, write the captured value to Column A
After the loop copy the Data Array back to the sheet
This works for me.
Sub TryMe()
' fill down from above
Range("A1:A20").Select ' change the range to suit your needs
Range("A20").Activate
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
' copy/paste values; no references to other cells
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select
' use come logic to do cleanup
Dim rng As Range, cell As Range
Set rng = Range("B1:B20") ' change the range to suit your needs
For Each cell In rng
If cell.Value = "" Then
cell.Offset(0, -1).Value = ""
End If
Next cell
End Sub
Before:
After:
I recorded a macro, it filters a sheet, copies the filtered data and pastes it into another workbook. It worked the first few times I used it, now it gives me an error:
Run-time 1004 - We can't Paste because the Copy area and Paste area
aren't the same size.
Nothing changed, it just now flags the error on the "ActiveSheet.Paste" line. Can anyone explain why it does this out of nowhere randomly? I know tomorrow when I try again it will work fine for a few uses then do this again. I looked online it seems to be a common issue, I haven't found a solution that has worked for me yet, does anyone have an idea? Or is there another way to do this maybe so I can just avoid it?
The code:
Sub Macro201()
ActiveSheet.Range("$A$6:$H$55").AutoFilter Field:=8, Criteria1:="99"
Range("A7:B7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoiceTEST.xls").Activate
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
Range("C" & Rows.Count).End(xlUp).Offset(1).Select
End Sub
First of all, you don't need to select anything. For example, Range("A7:B7") is a range. Selection is also a range (in this context). So, you assign the range to a Selection.Range and then use the Selection.Range. Why not use the Range you defined at the outset?
Next, you do have to specify the Worksheet you are working on, especially the one in the target workbook.
Finally, you must clearly identify the last rows you use. Your formula picks the last row in the sheets you work with, not the last used row. So you are throwing around millions of blank cells.
Put all of the above together and you arrive a code like the following.
Sub CopyData()
' 01 May 2017
Dim Rng As Range
With ActiveSheet
Set Rng = .Range("$A$6:$H$55")
Rng.AutoFilter Field:=8, Criteria1:="99"
If Application.WorksheetFunction.Subtotal(3, Rng) = 0 Then Exit Sub
.Range("A7:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).Copy
End With
With Workbooks("invoiceTEST.xls").Sheets(1)
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial
End With
End Sub
Note that the code will fail if the target workbook isn't open when you attempt to run it.
I've been having difficulties with figuring out how to code this select range macro to include blank rows. The worksheet is a chart with variable number of columns and rows. This is what I have so far:
Sub Macro1()
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
End Sub
The selection step in the macro will only go so far as that blank row and won't go any further (obviously because it's blank hehe). For that reason, I tried adapting this discontiguous type of code but with no luck:
Sub SelectRangeDown_Discontiguous()
Range("A5", Range("A65536").End(xlUp)).Select
End Sub
I was hoping someone could help me figure out the best way of writing this code? Am I on the right path?
If you are using .End(xlToRight) or .End(xlDown) you are going to stop at blank cells. If you are using Range("A65536").End(xlUp) then you are only selecting a single column but you are getting everything from A5 down to the last populated cell and bypassing interim blank cells. Extend this latter method laterally.
Sub Macro1()
with Range("A5")
.resize(cells(rows.count, "A").end(xlup).row - (.row - 1), _
cells(5, columns.count).end(xltoleft).column - (.column - 1)).Copy
end with
End Sub
This would be better with a .Parent Worksheet Object.
You do not need to .Select method something in order to .Copy it¹.
¹ 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.
Consider:
Sub whatever()
Dim r1 As Range, r2 As Range
ActiveSheet.UsedRange
Set r1 = Range(Cells(5, 1), Cells(Rows.Count, Columns.Count))
Set r2 = Intersect(r1, ActiveSheet.UsedRange)
End Sub
First thing I did was create a button that would copy certain cells using this code:
Worksheets("Sheet1").Range("A:A,B:B,D:D").Copy _
and it worked fine.
Second, I found the code that would copy all details in a row based on the criteria of one, in this case if there was an "A" in the "Location" column.
Private Sub ENTIREROW_Click()
'Sub copyrows()
Dim i As Range, Cell As Object
Set i = Range("D:D") 'Substitute with the range which includes your True/False values
For Each Cell In i
If IsEmpty(Cell) Then
Exit Sub
End If
If Cell.Value = "A" Then
Cell.ENTIREROW.Copy
Sheet2.Select 'Substitute with your sheet
ActiveSheet.Range("A65536").End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
End Sub
My question is, how do I copy all information in the specified columns (A,B,D) where there is an "A" in "Location" in one button.
Furthermore, this is my example data, the sheet I will actually use this on has 34 columns to copy. Is there a more efficient way of setting a range when you don't want an entire sequence, everything but the data in column C?
Thanks in advance and apologies for my explanation skills.
One way maybe to:
filter your source
hide column C
copy the result using .PasteSpecial xlPasteValues into the destination
Unhide column C on the source sheet
remove the autofilter
Using xlPasteValues only pastes the visible cells from the source - so no column C
The code then looks like this: .
Sub CopyRows()
With Sheets(1).Range([A2], [A2].SpecialCells(xlLastCell))
[A1].AutoFilter
.AutoFilter Field:=4, Criteria1:="A"
[C:C].EntireColumn.Hidden = True
.Copy
[C:C].EntireColumn.Hidden = False
End With
With Sheets(2)
If .Cells(Sheets(2).Rows.Count, 1).End(xlUp) = "" Then 'it's a clean sheet
.Cells(Sheets(2).Rows.Count, 1).End(xlUp).PasteSpecial Paste:=xlPasteValues
Else
.Cells(Sheets(2).Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
End With
Application.CutCopyMode = False
Sheet1.[A1].AutoFilter
End Sub
If I apply auto-filter on my input sheet and then run VBA code, the code does not care about the auto-filter.
But, sometimes running VBA code on an auto-filtered sheet messes up the results of the program.
So, my question is; does VBA care about auto-filter?
For example:
Sub check()
Dim rng as range
Set rng = Sheets("input").Range("A1")
row = 0
Do until rng.offset(row,0) = ""
row = row + 1
Loop
End Sub
In the above code, VBA does not care if auto-filter is applied on column A, and it still iterates through all the rows. However, if I try to write on cells where there is auto-filter, it messes up.
VBA Doesn't care about Autofilter unless you "tell it" to or are trying to perform actions which can get affected by the Autofilter.
Your above code will work with any sheet and not just with "Input" Sheet.
Here is another method where it works beautifully (in fact I use it all the time)
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
'~~> Filter, offset(to exclude headers) and delete visible rows
With rRange
.AutoFilter Field:=1, Criteria1:=strCriteria
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
And here is a scenario when it doesn't work.
Charts don't show data which were filtered by Autofilter. But then the chart also doesn't show data which is present in hidden rows. This applies to both VBA and Non VBA methods of showing data in the chart.
but if i try to write on particular cells where autofiler is applied it messes up.
It depends on how and where you are writing it.
This works very nicely. Note in the below code, row has been filtered and is not visible. However, we can still write to it.
Option Explicit
Sub Sample()
Dim rng As Range
Set rng = Sheets("Sheet1").Range("A1")
rng.AutoFilter Field:=1, Criteria1:="<>1", Operator:=xlAnd
rng.Offset(1, 0).Value = "Sidd"
End Sub
Now let's take another case. This will not work. Let's say you have a range A2 to A10 (A1 has Header) which has various values ranging from 1 to 3. Now you want to replace all the values in A2:A10 by say 1000. This code will not give you the expected output if there is an Autofilter. It will not change all the cells.
Option Explicit
Sub Sample()
Dim rng As Range
Set rng = Sheets("Sheet1").Range("A1:A10")
rng.AutoFilter Field:=1, Criteria1:="<>1", Operator:=xlAnd
rng.Value = "1000"
End Sub
Why does it ignore the cells which have "1" (i.e the rows which were filtered out) and writes to rest of the rows? In fact it messes up with the header as well???
It's quite simple. The idea of having Autofilter is get the relevant data as per what our requirement is (at the moment it is data which is <> 1). When you write to the range rng then it will write to all cells which are visible (including the cell which has header) in that range.
So what do we do in this case?
You have two options
1) Remove the Autofilter - Do the necessary actions - Put the filter back
Sub Sample()
Dim rng As Range
Set rng = Sheets("Sheet1").Range("A1:A10")
'~~> Put Filter
rng.AutoFilter Field:=1, Criteria1:="<>1", Operator:=xlAnd
'~~> Remove Filter
ActiveSheet.AutoFilterMode = False
'~~> Write value to the cells (See how we ignore the header)
Sheets("Sheet1").Range("A2:A10").Value = "1000"
'~~> Put Filter back
rng.AutoFilter Field:=1, Criteria1:="<>1", Operator:=xlAnd
End Sub
2) Loop the range as you did in your question
Sub Sample()
Dim rng As Range, cl As Range
Set rng = Sheets("Sheet2").Range("A1:A10")
rng.AutoFilter Field:=1, Criteria1:="<>1", Operator:=xlAnd
For Each cl In rng
'~~> Ignoring the Header
If cl.Row <> 1 then _
cl.Value = "1000"
Next
End Sub
When you run the above code, it writes to all the cells except the header.
I would recommend you to read Excel's inbuilt help to understand how AutoFilters actually work. That would help you understand them which will in turn help you handle sheets which have Autofilter turned on.
HTH