Select range cells with blank rows - excel

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

Related

Creating a new column and pasting data into that new column with VBA

I am attempting to create a new column on a different sheet and then copy data into that column.
Below is the code I have written. The first sub is a new column to the left and the second sub is the column to the right.
The insert column part is working. I hid a column and have a cell in there as a named range which I used to select in my macro. The data I want to copy is on the Input sheet and is named InputData.
Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
Sheets("Data").Activate
Sheets("Data").Range("DividerColumn").Select
Selection.EntireColumn.Offset(0, 0).Insert Shift:=xlToLeft
'Sheets("Input").Activate
'Range("InputData").Copy
'Sheets("Data").Activate
'ActiveCell offset maybe?
'Range().PasteSpecial xlPasteValues
Call sourceSheet.Activate
End Sub
Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
Sheets("Data").Activate
Sheets("Data").Range("DividerColumn").Select
Selection.EntireColumn.Offset(0, 1).Insert Shift:=xlToRight
Call sourceSheet.Activate
End Sub
Oh I didn't see your copy range. In that case this could probably work. I see you just got the answer, but this would be a good way to avoid select.
Sub copyToLeft()
Call doTheCopy(False)
End Sub
Sub CopyToRight()
Call doTheCopy(True)
End Sub
Private Sub doTheCopy(goRightIsTrue As Boolean)
With Sheets("Data").Range("DividerColumn").EntireColumn.Offset(0, IIf(goRightIsTrue, 1, 0))
.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
.Offset(0, -1).Value = Sheets("Input").Range("InputData").EntireColumn.Value
End With
End Sub
I found the solution by using an offset function. Below is my code. Hope this helps someone with a similar situation.
Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
Sheets("Data").Activate
Sheets("Data").Range("DividerColumn").Select
Selection.EntireColumn.Offset(0, 0).Insert
Shift:=xlToLeft
Sheets("Input").Activate
Range("InputData").Copy
Sheets("Data").Activate
Range("DividerColumn").Select
ActiveCell.Offset(0, -1).PasteSpecial
xlPasteValues
Call sourceSheet.Activate
End Sub
-1 in the offset function moves your active cell to the left one cell and then 1 moves it to the right. So once the column is created, either right or left, my macro goes and copies the information and then goes back to the sheet I want it to and selects my named range again and then it gets moved to the left and pastes my data.

Cannot copy to the last cell in the range

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.

Excel VBA Insert copied cells and shift cells down ERROR

Complete amateur here. I've been puzzling over this for hours, and I can't find anything to help me in any other thread. At my wit's end so sorry if this has been asked elsewhere.
I'm trying to create a ridiculously simple macro to do the following:
Go to Sheet2,
Select C6:C10
Copy
Go to Sheet3
Insert copied cells in B2 and shift the other cells down.
I did this just by recording the macro, but each time I do it, I get different errors. The error I currently have is 'Insert Method of Range Class Failed', but sometimes the error pops up at 'Selection.Copy'. This is the code I have:
Sub InsertCellsShitDown()
'
' InsertCellsShitDown Macro
'
'
Sheets("Booking Sheet").Select
Range("C6:C10").Select
Selection.Copy
Sheets("Sheet1").Select
Range("B2").Select
Selection.Insert Shift:=xlDown
End Sub
Any help would be hugely appreciated.
Sub InsertCellsShiftDown()
'
' InsertCellsShitDown Macro
Dim bookingWS As Worksheet, mainWS As Worksheet
Dim copyRng As Range
Set bookingWS = Sheets("Booking Sheet")
Set mainWS = Sheets("Sheet1")
Set copyRng = bookingWS.Range("C6:C10")
mainWS.Range("B2:B" & copyRng.Rows.Count + 1).Insert Shift:=xlDown
copyRng.Copy mainWS.Range("B2")
End Sub
How does this work? I assume you wanted to insert 5 rows, so from B2:B7, then put the data.

Excel VBA - Copy range from one sheet to another, next empty row

I'm trying to take a range from one sheet and copy it to the next empty row in another sheet (basically, paste into the range A12:D12 for next empty row in the other sheet). The range will never change. I've seen a lot of questions like this, with people saying the answers work great, but I can't get it to work.
Very new to VBA. Here is the code I'm using:
Private Sub CommandButton1_Click()
Dim NextRow As Range
Set NextRow = Range("A" & Sheets("Sheet3").UsedRange.Rows.Count + 1)
Sheet1.Range("A12:D12").Copy
Sheet3.Activate
NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
Application.CutCopyMode = False
Set NextRow = Nothing
End Sub
This runs but it doesn't actually paste any values into Sheet3. Is there something I'm missing? Is there a better way to do this?
Thanks!
You just had an issue in the second line defining NextRow.
Is there a better way to do this? It depends on your needs; personally I do not like to activate/select other cells during a VBA macro so e.g. I would get rid of the Sheet3.Activate. I would also copy the stuff 'manually' without using the clipboard to avoid changing the user's clipboard contents.
Private Sub CommandButton1_Click()
Dim NextRow As Range
Set NextRow = Sheet3.Range("A" & Sheet3.Rows.Count).End(xlUp).Offset(1, 0)
Sheet1.Range("A12:D12").Copy
Sheet3.Activate
NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
Application.CutCopyMode = False
Set NextRow = Nothing
End Sub

excel database function in combination with vba, what if there are no records?

I'm using the database function of excel. see example image
I use vba to select records that have 'yes' for lets say A
Selection.AutoFilter Field:=2, Criteria1:="yes"
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
I then copy it to paste it somewhere else. for example:
Selection.Copy
Range("B12").Select
ActiveSheet.Paste
The problem is that when there are no records with yes, i get error 1004. Probably because there is nothing to paste. How do I write a script so that if there is nothing to paste, it exits the sub?
I tried things like counta but to no succes.
Your help is much appreciated! :)
I like doing it this way because you don't need to error check it. If there are no results, it will simply paste a blank cell:
Sub tgr()
With Range("B2").CurrentRegion
.AutoFilter 2, "yes"
Intersect(.Offset(1), Columns("B")).Copy Range("B12")
.AutoFilter
End With
End Sub
Alternately, if you only have one criteria, you could use Countif to test if the criteria exists before performing the filter:
Sub tgr()
Dim strCriteria As String
strCriteria = "yes"
With Range("B2").CurrentRegion
If WorksheetFunction.CountIf(Intersect(.Cells, Columns("C")), strCriteria) > 0 Then
.AutoFilter 2, strCriteria
Intersect(.Offset(1), Columns("B")).Copy Range("B12")
.AutoFilter
Else
MsgBox "No cells found to contain """ & strCriteria & """", , "No Matches"
End If
End With
End Sub
This will check the number of visible cells after the AutoFilter is applied:
Selection.AutoFilter Field:=2, Criteria1:="yes"
If ActiveSheet.AutoFilter.Range.Rows.Offset(1, 0).SpecialCells(xlCellTypeVisible).Count - ActiveSheet.AutoFilter.Range.Columns.Count > 0 Then
Range("B3").Select
Range(Range("b3"), Range("b2").End(xlDown)).Select
Selection.Copy
Range("B12").Select
ActiveSheet.Paste
End If
The - ActiveSheet.AutoFilter.Range.Columns.Count part is to subtract the header cells from the count.
FWIW, when I walked through your original code, I got the 1004 because the Copy area was from B7 to the bottom of the sheet (the effect of xlDown in an empty selection).
You can use the SUBTOTAL worksheet function to count the visible rows and only do the copy and paste if there are visible rows. Here's an example.
Sub CopyFiltered()
Dim rToFilter As Range
Dim rToCopy As Range
Dim rToPaste As Range
Set rToFilter = Selection
Set rToPaste = rToFilter.Cells(1).Offset(10, 0) 'paste it 10 rows down
rToFilter.AutoFilter 2, "yes"
'Use subototal to count the visible rows in column 1
If Application.WorksheetFunction.Subtotal(2, rToFilter.Columns(1)) > 0 Then
'Copy excluding the header row
Set rToCopy = rToFilter.Columns(1).Offset(1, 0).Resize(rToFilter.Rows.Count - 1)
rToCopy.Copy Destination:=rToPaste
End If
End Sub

Resources