What are the best ways to move excel ranges around using VBA? For as frequently as I need to do it, I still have a lot of trouble with it. I'd like to show my most-used approaches for criticism and/or suggestions of new ways to go about moving ranges.
The cut/copy method seems to be really finicky, especially when multiple worksheets or variables are involved. For example:
Dim wkb1 as Workbook
Dim wks1 as Worksheet, wks2 as Worksheet
Set wbk1 = ThisWorkbook
Set wks1 = wbk1.Worksheets(1)
Set wks2 = wbk1.Worksheets(2)
wks1.Range("A1:A5").Copy (wks2.Range("A1"))
' Error: Object variable or With Block variable not set.
wbk1.Worksheets(1).Range("A1:A5").Copy (wbk1.Worksheets(2).Range("A1"))
' This works.
I would think that avoiding the clipboard increases execution speed. Here, I simply equate one range to another. The drawback is that it requires ranges of equal dimensions:
' Copy a range of two equal dimensions.
WrkSht2.Range("A1:F" & (rngEndRange.row - 10)).Value = _
WrkSht2.Range("A10", rngEndRange).Value
I like the idea of using collections, but there's the draw back of added complexity from needing to work with loops.
Sub UseCollection()
Dim MySheet As Worksheet
Dim lngLastRow As Long
Dim rngSearch As Range, rngCell As Range, rngCopy As Range
Dim MyCollection As New Collection
Set MySheet = ThisWorkbook.Worksheets(1)
Set CopySheet = ThisWorkbook.Worksheets(3)
lngLastRow = MySheet.Range("A1").End(xlDown).Row
Set rngSearch = MySheet.Range("A1:A" & lngLastRow)
Set rngCopy = CopySheet.Range("A1")
For Each rngCell In rngSearch
MyCollection.Add rngCell.Value
Next rngCell
i = 1
For Each Element In MyCollection
rngCopy(i, 1) = Element
i = i + 1
Next Element
End Sub
So how do you all go about copying ranges? Ideally, an approach should be easy to use with worksheet/range variables, and it should be relatively simple.
Yes the range size is a slight faff which is one reason why I often don't bother, but you can do it this way:
Sub x()
Dim r1 As Range
Set r1 = Range("A1:C3")
With r1
Range("F1").Resize(.Rows.Count, .Columns.Count).Value = r1.Value
End With
End Sub
Edit: think this is what BigBen's comment means.
...Or a bit shorter 😎
Sub x()
With Range("A1:C3")
Range("F1").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End Sub
Related
I'm trying to define a range by the contents of two different cells, each containing the indirect cell addresses. I'm not sure whether it's possible, but here's an example:
Cell X100 contains value $A$1
Cell Y200 contains values $C$5
Is there any way I can use Range() and cells X100 and Y200 to arrive at Range("$A$1:$C$5")?
I've tried using Cells.Address but I can't figure out the right format for the application. Any help is appreciated!
Thanks
Edit
Thank you Tom! I have another question for you. The X100 cell is actually variable in my case, and I was using the following formula to find it:
Cells.Find("ID").Offset(1,0).Address
Is there any way to incorporate this sort of formula into the Range application? Or would it be easier to define a static cell in the spreadsheet containing this formula?
Thanks a bunch
Edit 2
Here you are! I'm dimming r and x as ranges and setting them as follows:
r = Cells.Find("ID").Offset(1,0).Address
x = Cells.Find("Description of initiative").offset(1,0).end(xldown).Offset(0,cells.Find("ID").Column-cells.Find("Description of initiative").Column).address
They're convoluted I know, but I printed them out and they are returning the right cells in the $A$1 format.
Hope this clarifies! Really appreciate your help.
Do you mean
Range(Range("X100").Value2 & ":" & Range("Y200").Value2)
Rather than working with addresses, work with Range objects.
Not sure I fully understand your setup, but something like this is maybe what you're looking for.
Sub Test()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim startCell As Range
Set startCell = ws.Cells.Find(What:="ID") '<--- you should specify the other parameters of Find
Dim endCell As Range
Set endCell = ws.Cells.Find(What:="Description of initiative") '<--- again, specify parameters of Find
If startCell Is Nothing Then Exit Sub '<--- Find was unsuccessful
If endCell Is Nothing Then Exit Sub '<--- Find was unsuccessful
Set startCell = startCell.Offset(1, 0)
Dim columnOffset As Long
columnOffset = startCell.Column - endCell.Column
Set endCell = endCell.Offset(1).End(xlDown)
Set endCell = endCell.Offset(, columnOffset) '<--- there's a simpler way to do this, this just gets you back to startCell.Column, but preserving your logic
Dim myRange As Range
Set myRange = ws.Range(startCell, endCell)
End Sub
Here's the simpler way to get endCell instead of the offset.
Sub Test()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim startCell As Range
Set startCell = ws.Cells.Find(What:="ID") '<--- you should specify the other parameters of Find
Dim endCell As Range
Set endCell = ws.Cells.Find(What:="Description of initiative") '<--- again, specify parameters of Find
If startCell Is Nothing Then Exit Sub '<--- Find was unsuccessful
If endCell Is Nothing Then Exit Sub '<--- Find was unsuccessful
Set startCell = startCell.Offset(1, 0)
Dim lastRow As Long
lastRow = endCell.Offset(1).End(xlDown).Row
Set endCell = ws.Cells(lastRow, startCell.Column)
Dim myRange As Range
Set myRange = ws.Range(startCell, endCell)
End Sub
I'm trying to look for the last row of data between column A and I and then duplicate the value to the row below which is empty.
Every time I run it, Excel crashes
Sub insert_row()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
LastRow = LastRow
Dim lastrow_start As String
Dim lastrow_end As String
lastrow_start = "A" & LastRow
lastrow_end = "I" & LastRow
Dim lastrowregion As String
lastrowregion = lastrow_start & ":" & lastrow_end
Dim lastrowrange As Range
Set lastrowrange = Range(lastrowregion)
Dim rng As Range
Set rng = Range(lastrow_start)
Do While (rng.Value <> "")
rng.Offset(1).insert
lastrowrange.Copy rng.Offset(1)
Set lastrowrange = rng.Offset(2)
Loop
End Sub
Is it just copying too much and causing a crash? It's only nine columns and they're all text apart from one cell which is a shape (button).
You are trying to set a String to a range object. To get the range use:
Set rng = Range(lastrowregion)
The Range you are getting is A2:I2. So your Do While will error because rng.Value is actually returning an Array. You could either loop through either the Range or the Array at that point if you intended on it being multiple cells.
If the goal is simply to copy the last row of data down one row then this method can be much simpler. You can simply set the Offset to equal the value of the last row. Since they are the same size it will just work.
To show this I used CurrentRegion but you could also do it with your A2:I2 Range.
Public Sub copyLastRowDown()
Dim region As Range
Set region = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
With region.Rows(region.Rows.Count)
.Offset(1).Value = .Value
End With
End Sub
Additional Notes
Use Option Explicit to ensure all variables are explicitly declared.
Declare and assign variables next to where they are going to be used, but place them in a reasonable place.
Do not use underscore case as this has special meaning with events and interfaces.
I am attempting to copy filtered data from one sheet to another. It copies everything to the same line.
How do populates all the rows instead of copying them over the same one?
Here is the code I modified:
Private Sub Workbook_Open()
Dim i, LastRow
LastRow = Sheets("Scheduled WO's").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Branden").Range("A2:Q10000").ClearContents
For i = 2 To LastRow
If Sheets("Scheduled WO's").Cells(i, "G").Value = "Branden" Then
Sheets("Scheduled WO's").Cells(i, "G").EntireRow.Copy Destination:=Sheets("Branden").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next
End Sub
you have to take off the statement
Sheets("Branden").Range("A2:Q10000").ClearContents
which clears "Branden" worksheet cells at every opening of the workbook it resides in
furthermore, since your need is filtering, you may want to use Autofilter and avoid looping through cells
Private Sub Workbook_Open()
With Worksheets("Scheduled WO's")
With .Range("G1:G" & .Cells(.Rows.Count, 1).End(xlUp).Row)
.AutoFilter field:=1, Criteria1:="Branden"
If Application.WorksheetFunction.Subtotal(103, .Cells) - 1 > 0 Then .Offset(1).Resize(.Rows.Count - 1).SpecialCells(XlCellType.xlCellTypeVisible).EntireRow.Copy Worksheets("Branden").Range("A" & Rows.Count).End(xlUp).Offset(1)
End With
.AutoFilterMode = False
End With
End Sub
Copy Rows Based On Matching Criteria From One Sheet To Another
There's 2 ways we can go about this.
Code 1
The first is sticking with what you were doing, which may or may not be the slower way of accomplishing this (depending on how many cells you're moving through.)
Option Explicit
Private Sub Workbook_Open()
Dim wsWO As Worksheet: Set wsWO = ThisWorkbook.Sheets("Scheduled WO's")
Dim wsB As Worksheet: Set wsB = ThisWorkbook.Sheets("Branden")
Dim LastRow As Long: LastRow = wsWO.Cells(wsWO.Rows.Count, 1).End(xlUp).Row
Dim i As Long
wsB.Range("A2:Q10000").ClearContents
For i = 2 To LastRow
If wsWO.Cells(i, "G").Value = "Branden" Then _
wsWO.Cells(i, "G").EntireRow.Copy _
wsB.Range("A" & wsB.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1)
Next i
End Sub
Code 2
The other way we can do this is by specifically finding only occurences of "Branden", and copying those rows over.
Option Explicit
Private Sub Workbook_Open()
Dim wsWO As Worksheet: Set wsWO = ThisWorkbook.Sheets("Scheduled WO's")
Dim wsB As Worksheet: Set wsB = ThisWorkbook.Sheets("Branden")
Dim findBranden As Range: Set findBranden = wsWO.Range("G:G") _
.Find(What:="Branden", LookIn:=xlValues, LookAt:=xlWhole)
Dim firstResult As String
wsB.Range("A2:Q10000").ClearContents
If Not findBranden Is Nothing Then
firstResult = findBranden.Address
Do
findBranden.EntireRow.Copy _
wsB.Range("A" & wsB.Cells(wsB.Rows.Count, 1).End(xlUp).Row + 1)
Set findBranden = wsWO.Range("G:G").FindNext(findBranden)
Loop While Not findBranden Is Nothing And findBranden.Address <> firstResult
Else: MsgBox "Nothing to move today.", vbInformation, ""
End If
End Sub
You'll notice there's a couple new things in both codes.
An important one is Option Explicit. Including this at the top of your code module will alert you at compile if you have any variables that aren't declared. This is incredibly useful because it will catch spelling mistakes and the like before your code runs. I dare say all experienced VBA coders use Option Explicit or have Require Variable Declaration turned on in the Tools > Options > Editor menu.
Another very important change was declaring the specific type of variables we are using. In your code, LastRow and i are assumed as Variant types because you never specified their use. It's good practice to be as specific as you can in coding, especially with variable declarations, because it will make troubleshooting your code a lot more simple.
I also declared your worksheets as variables to make the written code smaller, and easier to read.
Literature You May Find Useful
Why Option Explicit?
Why Require Variable Declaration?
Why declare the specific type of variable?
Both methods are viable and easy to manipulate. Let me know if I've managed to help :)
I have the following UDF, saved into a module of my workbook:
Function sumAbove2(myCell As Range)
Dim rng As Range, cel As Range
Dim topRow As Long
topRow = myCell.Offset(0, -2).End(xlUp).Row
Dim sRng As Range, eRng As Range
Set sRng = Cells(myCell.Row, myCell.Column)
Set eRng = Cells(topRow, myCell.Column)
For Each cel In Range(sRng, eRng)
Debug.Print cel.Address
sumAbove2 = cel.Value + sumAbove2
Next cel
End Function
The idea is to automatically sum "blocks" of information.
The UDF works just fine when I walk through it with F8. But, when running automatically, it can give unexpected results. The annoying thing is that I have placed this code in a brand new workbook, threw in sample data, and it never generated incorrect results...so for that, I apologize my SO friends, I can't quite get it to reproduce. I'm relatively new to UDF, so may be missing some key point about running them (does volatility help/hurt?)
And when I do this, two seconds later, with a Break in the macro, I can step through with F8, it correctly adds nothing, and returns 0.
What could be going on? I didn't specify the sheet in the code, but I can't see why that would fix it. Could it have to do with some other formulas on the page? There's no worksheet_change event, etc.
Edit: The workbook has a few sheets, with formulas in those sheets. But the sheet I'm running this on is all text, save the formula I'm trying to enter. Just thought to mention in case something in formatting could be giving the odd behavior.
I would 1) simplify the code a bit (you're not using the rng variable for anything and you don't really need the start and end row ranges in separate variables), 2) define the data type to be returned, 3) use fully qualified references and 4) add a numeric check the following way:
Function sumAbove2(myCell As Range) As Double
Dim actSht As Excel.Worksheet
Dim topRow As Long
Dim cel As Range, searchRng As Range
topRow = myCell.Offset(0, -2).End(xlUp).Row
Set actSht = ActiveSheet
With actSht
Set searchRng = .Range(.Cells(myCell.Row, myCell.Column), .Cells(topRow, myCell.Column))
End With
For Each cel In searchRng
If IsNumeric(cel.Value) Then sumAbove2 = cel.Value + sumAbove2
Next cel
End Function
Seems to work flawlessly by me.
You need to fully qualify all your ranges with the correct worksheet...
Function sumAbove2(myCell As Range)
Dim sht As Worksheet '<<<
Dim rng As Range, cel As Range
Dim topRow As Long
Dim sRng As Range, eRng As Range
Set sht = myCell.Worksheet '<<<
topRow = myCell.Offset(0, -2).End(xlUp).Row
Set sRng = sht.Cells(myCell.Row, myCell.Column) '<<<
Set eRng = sht.Cells(topRow, myCell.Column) '<<<
For Each cel In sht.Range(sRng, eRng) '<<<
Debug.Print cel.Address
sumAbove2 = cel.Value + sumAbove2
Next cel
End Function
Edit: debugging UDF #VALUE errors from the worksheet is tricky - you will get more information if you debug by calling the function from a test sub:
Sub Tester()
Debug.Print sumAbove2(Activesheet.Range("C44"))
End sub
I am trying to execute a simple code to create a Pivot Table using my data.
Sub PTable()
Dim PT As PivotTable
Dim PTCache As PivotCache
Dim rng As Range
Set rng = Range("A1", Range("A1").End(xlToRight).End(xlDown))
rng.Select
Set PTCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, rng)
Sheets("New").Activate
Set PT = ActiveSheet.PivotTables.Add(PTCache, Range("A1"), "My_PT")
End Sub
Runtime error 13, Type Mismatch is thrown while setting PTCache. This has been happening very frequently whenever I am working with Pivot Tables on my excel using VBA.
This string Set rng = Range("A1", Range("A1").End(xlToRight).End(xlDown)) is setting very huge range "$1:$1048576".
You can watch it in debugger:
Range("A1", Range("A1").End(xlToRight).End(xlDown)).Address
=> "$1:$1048576"
Maybe something wrong with the range, that you want to use in ActiveWorkbook.PivotCaches.Create?
Try also use this Microsoft's advice about second argument PivotCache.Create:
When passing as a range, it is recommended to either use a string to
specify the workbook, worksheet, and cell range, or set up a named
range and pass the name as a string. Passing a Range object may
cause "type mismatch" errors unexpectedly.
Also, you might try
Set rng = Range("A1").CurrentRegion
which is like Ctrl+Shift+* instead of
Set rng = Range("A1", Range("A1").End(xlToRight).End(xlDown))
Performing a single method (i.e., .CurrentRegion) instead of two methods (i.e., xlToRight followed by xlDown) is likely to be less memory intensive and resolve the Type Mismatch glitch.
I had the same issue as you. I had a code working perfectly until the number of rows was over 60.000 lines, then error 13 :Type mismatch appeared when creating the PivotCache...
Solution: Instead of using a Range variable to store the range do it in a string variable. That way (I don't know why) you can avoid having that error. This code should work:
Sub PTable()
Dim PT As PivotTable
Dim PTCache As PivotCache
'Dim rng As Range
Dim LastRow As Long
Dim LastColumn As Long
Dim RangeString As String
Dim SheetName As String
'Set rng = Range("A1", Range("A1").End(xlToRight).End(xlDown))
'rng.Select
LastRow = UsedRange.Rows.Count
LastColumn = UsedRange.Columns.Count
SheetName = ActiveSheet.Name
RangeString = SheetName & "!R1C1:R" & LastRow & "C" & LastColumn
Set PTCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, RangeString)
Sheets("New").Activate
Set PT = ActiveSheet.PivotTables.Add(PTCache, Range("A1"), "My_PT")
End Sub