Here is my problem. I have two Range Object. For example,
Set rg3 = Range("B2")
Set rg4 = Range("B3000")
I want to do this
Range("rg3:rg4").PasteSpecial (xlPasteAll)
But it show error. How can I select the region by two range object.
Range("B2:B3000") is not correct in my case because those two range would always updated by offset function.
Thanks for your help!!!
When you enter Range( the intellisense will show Range(Cell1, Cell2) as Range indicating the the Range object is expecting two cells.
So, seeing as rg3 and rg4 are two cells you can use Range(rg3, rg4).
You're using xlPasteAll so you could just use RangeBeingCopiedReference.Copy Destination:=Range(rg3,rg4)
Edit - and as #Robin says, what do you mean by the offsetting?
Edit 2:
If you want to loop through a range then using Cells is easier as it accepts a column number rather than a column letter.
This example will copy columns A:J over to U:AD one column at a time.
Sub Test()
Dim rg3 As Range, rg4 As Range
Dim x As Long
With ThisWorkbook.Worksheets("Sheet1")
For x = 1 To 10
.Range(.Cells(2, x), .Cells(3000, x)).Copy _
Destination:=.Range(.Cells(2, x + 20), .Cells(3000, x + 20))
Next x
End With
End Sub
Also - look up reference on WITH... END WITH - https://msdn.microsoft.com/en-us/library/wc500chb.aspx
I'd like to better understand your needs for better help
as a start, since your using of .PasteSpecial xlPasteAll I'd believe you're setting a source range outside a loop and paste it multiple times inside this latter shifting pasting range
you also explained "rg3 and rg4 is inside a for loop, each time it will move to next colmn by offset(0, 1)"
so this would initially lead to:
Option Explicit
Sub main()
Dim copyRng As Range, rg3 As Range, rg4 As Range
Dim i As Long
Set rg3 = Range("B2") '<~~ your rg3 range setting
Set rg4 = Range("B3000") '<~~ your rg4 range setting
Set copyRng = ... '<~~ your setting of the "source" range to be copied once and pasted many
copyRng.Copy '<~~ copy "source" Range once ...
With Range(rg3, rg4) '<~~ ... set your initial "target" range ...
For i = 1 To 10
.Offset(, i).PasteSpecial xlPasteAll '<~~ ... and paste "source" range offseting "target" once
Next i
End With
End Sub
but this would also be uselessly long and slow, since you could simply write:
Option Explicit
Sub main()
Dim copyRng As Range, rg3 As Range
Set rg3 = Range("B2") '<~~ just set the "beginning" of the target range
Set copyRng = ... '<~~ your setting of the "source" range to be copied once and pasted many
copyRng.Copy copyRng.Copy Destination:=rg3.Resize(, 10)
End Sub
so what's your real need?
Related
the aim of my problem is to find a specific value (Text) and then refer to the entire row (or even better only the used range to the right of my active cell) in a For/Each loop.
The first part works fine of finding my value, however, the code for targeting the row of the active cell (so the cell found by the find function), does not work yet:
Sub Search()
Dim cell As Range
Dim Count As Long
Set cell = Cells.Find(what:="Planned Supply at BP|SL (EA)", LookIn:=xlValues, lookat:=xlWhole)
For Each cell In ActiveCell.EntireRow
If cell.Value = "0" Then
Count = Count + 1
End If
Next cell
Range("I1").Value = Count
End Sub
The following code will find the range to the right of your found cell and use your loop to do the comparision for each cell in the range. That part could probably be improved by using WorksheetFunction.CountIf.
Option Explicit
Sub Search()
Dim wks As Worksheet
Set wks = ActiveSheet
Dim cell As Range, sngCell As Range
Dim Count As Long
Set cell = wks.Cells.Find(what:="Planned Supply at BP|SL (EA)", LookIn:=xlValues, lookat:=xlWhole)
If cell Is Nothing Then Exit Sub ' just stop in case no hit
Dim rg As Range, lastColumn As Long
With wks
lastColumn = .Cells(cell.Row, .Columns.Count).End(xlToLeft).Column ' last used column in cell.row
Set rg = Range(cell, .Cells(cell.Row, lastColumn)) ' used rg right from found cell inlcuding found cell
End With
' loop from the original post
For Each sngCell In rg
If sngCell.Value = "0" Then
Count = Count + 1
End If
Next
Range("I1").Value = Count
End Sub
I am trying to get a small matrix of data from one workbook and paste it into ThisWorkbook using offset from a cell reference. The cell reference changes though as I'm cycling down a range looking for values. The variable I've set called 'WhereCell' holds the address of the currently held value, and I want to offset from whatever is held in WhereCell. It works if I hard code a cell reference, eg Range("A1") but with the code as it is I get a 1004: Method 'range' of object '_Global' failed.
How can I change it to offset from 'WhereCell'?
Sub GetFlows()
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim dem1 As String
Dim WhereCell As Range
Dim valueRng As Range
Dim x As Long
Dim y As Long
Set rng = Range("A9:A200")
For x = 1 To rng.Rows.Count
dem1 = rng.Cells(x).Value
If dem1 <> "" Then
Set WhereCell = ThisWorkbook.ActiveSheet.Range("A9:A200").Find(dem1, lookat:=xlPart)
Windows("GetFilenames v2.xlsm").Activate
Worksheets(dem1).Range("A1").CurrentRegion.Copy
ThisWorkbook.ActiveSheet.Range(Range(WhereCell), Range(WhereCell).Offset(, 2)).PasteSpecial Paste:=xlPasteValues
'MsgBox dem1
'If Not WhereCell Is Nothing Then
'MsgBox WhereCell.Address
'End If
Else
ThisWorkbook.Activate
End If
Next x
End Sub
Try like this:
WhereCell.Offset(0, 2)).PasteSpecial Paste:=xlPasteValues
instead of this:
ThisWorkbook.ActiveSheet.Range(Range(WhereCell), Range(WhereCell).Offset(, 2)).PasteSpec...
To understand more about WhereCell, consider writing
Debug.Print WhereCell.Parent.Name
Debug.Print WhereCell.Parent.Parent.Name
Debug.Print WhereCell.Address
after declaring it. It will show you its Worksheet, the name of the Application and its address in the immediate window. Thus, it already "knows" them and if you try to "redeclare" them, you get an error.
I'm writing a macro in Excel 2010 for a problem that is as follows:
I have two columns, one with a Key string value and one with a uuid. The idea is that every key should have only one uuid but as the table is now, key cell could be merged cells or single cells.
The macro needs to recognize which cells are merged and which are not, so, I have two options:
If cell is merged, check all its adjacent cells, pick first uuid value and copy/paste it to other adjacent cells, that is to say, cell below(Could be with an Offset())
If cell is not merged , but key value is repeated in multiple cells, copy/paste uuid value to adjacent cells.
So basically is to check merged cells MergeArea but I don't know if I need to iterate through its addresses or check cells in the range with an offset of Offset(0,1) or what.
With my code I can know if the cells are merged but now, how con I iterate through it's adjacent cells values?
Code as is now:
Sub CopyUUID()
Dim lRow As Long
Dim rng As Range
Dim ws As Worksheet
Dim rMerged As Range
Dim value As Variant
Set ws = Sheets(ActiveSheet.Name)
On Error GoTo ExitProgram 'If an error happens within the execution, skips it and continue in next step
Application.DisplayAlerts = False 'We can cancel the procedure without errors
With ws
lRow = .Range("F" & .Rows.count).End(xlUp).row
Set rng = .Range(.Cells(3, 6), .Cells(lRow, 6))
rng.Select
For Each cell In rng
If cell.MergeCells Then
'Code for merged cells
Else
'Code to use for single cells
End If
Next cell
End With
ExitProgram:
Exit Sub
End Sub
Option Explicit
Sub CopyUUID()
Const UUID As Long = 31 'col AE
Dim lRow As Long, cel As Range, isM As Boolean, copyID As Boolean, kCol As Long
With ActiveSheet
kCol = -25 'col F
lRow = .Cells(.Rows.Count, UUID + kCol).End(xlUp).Row
For Each cel In .Range(.Cells(3, UUID), .Cells(lRow, UUID))
isM = cel.Offset(0, kCol).MergeCells
copyID = isM And Len(cel.Offset(0, kCol)) = 0
copyID = copyID Or (Not isM And cel.Offset(0, kCol) = cel.Offset(-1, kCol))
If copyID Then cel = cel.Offset(-1)
Next
End With
End Sub
Try the following code. Note that this is going to overwrite the current contents of UUID, so make a backup copy before testing. If you don't want the UUID column modified, you can modify this to suit your needs.
Sub CopyUUID()
Dim lRow As Long
Dim rng As Range
Dim c As Range
Dim ws As Worksheet
Dim rMerged As Range
Dim value As Variant
Set ws = Sheets(ActiveSheet.Name)
On Error GoTo ExitProgram 'If an error happens within the execution, skips it and continue in next step
' Application.DisplayAlerts = False 'We can cancel the procedure without errors
With ws
lRow = .Range("F" & .Rows.Count).End(xlUp).Row
Set rng = .Range(.Cells(3, 6), .Cells(lRow, 6))
' rng.Select
For Each c In rng
If c.MergeCells Then
'Code for merged cells
c.Offset(0, 1).Formula = c.MergeArea.Cells(1, 1).Offset(0, 1).Formula
Else
'Code to use for single cells
If c.Formula = c.Offset(-1, 0).Formula Then
c.Offset(0, 1).Formula = c.Offset(-1, 1).Formula
End If
End If
Next c
End With
ExitProgram:
Exit Sub
End Sub
When in a MergedCell, it makes the UUID the same as the UUID of the first cell in the merged area. When not in a MergedCell, it copies UUID from the row above if Key is the same as the row above.
I changed your variable cell to c (I don't like to use variable names that can be confused with built-ins) and commented out a couple of lines.
Hope this helps
I adopt a simple approach to this problem as illustrated through steps taken by me.
sample sheet showing data with merged cells and unmerged cells.
Run the program code to unmerge the cells. Output of the program is appended below.
If this structure of data matches your case then addition of 2 lines of code for column B will leave the data as per following image.
Program code is as follows:
'Without column deletion:
Sub UnMergeRanges()
Dim cl As Range
Dim rMerged As Range
Dim v As Variant
For Each cl In ActiveSheet.UsedRange
If cl.MergeCells Then
Set rMerged = cl.MergeArea
v = rMerged.Cells(1, 1)
rMerged.MergeCells = False
rMerged = v
End If
Next
End Sub
'With coumn deletion
Sub UnMergeRangesB()
Dim cl As Range
Dim rMerged As Range
Dim v As Variant
For Each cl In ActiveSheet.UsedRange
If cl.MergeCells Then
Set rMerged = cl.MergeArea
v = rMerged.Cells(1, 1)
rMerged.MergeCells = False
rMerged = v
End If
Next
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
End Sub
I have cobbled together a subroutine to get two ranges of data from blocks of cells in two separate worksheets. Then, using the .Copy method, it puts the first block into (1, 1) of a third worksheet and the second block into the next available row of that worksheet.
The code I have written pretty much does what I want it to do, except that for some reason it will not paste the second range (declared as DataRng2 below) unless the sub is run twice in a row. Here is what I have:
Sub Test()
Dim DataRng As Range
Dim DataRng2 As Range
Dim Test As Worksheet
Dim EmtyRow As Range
Application.ScreenUpdating = False
Set Test = Worksheets("Test")
'Set the "EmptyRow" reference to whatever the next empty row is in the destination worksheet - checks column A
Set EmptyRow = Worksheets("Test").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'Select all utilized cells in 82-Medicine tab and copy them
Worksheets("82-Medicine").Select
Set DataRng = Worksheets("82-Medicine").Cells(2, 1).CurrentRegion
'Select the destination worksheet and paste copied cells to A1
Test.Select
DataRng.Copy Cells(1, 1)
'Select all utilized cells in Fee Basis tab and copy them
Worksheets("Fee Basis").Select
Set DataRng2 = Worksheets("Fee Basis").Cells(2, 1).CurrentRegion
'Select the destination worksheet and paste copied cells to the next empty row
Test.Select
DataRng2.Copy EmptyRow
Application.ScreenUpdating = True
End Sub
Why do I have to run it twice to get it to work? Is there a way to fix that?
I should note that I am using the .CurrentRegion property to get the data only because rows of data will frequently be added to and subtracted from the ranges of cells I need to grab, and .CurrentRegion is the simplest way I know to grab the first range of whatever cells are occupied. I am open to using a different property or method if necessary.
Option Explicit
Sub Test()
Dim src_1 As Worksheet
Dim src_2 As Worksheet
Dim dest As Worksheet
Dim src_1_rng As Range
Dim src_2_rng As Range
Dim lr As Integer
Dim lc As Integer
Set src_1 = ThisWorkbook.Sheets("82-Medicine")
Set src_2 = ThisWorkbook.Sheets("FeeBasis")
Set dest = ThisWorkbook.Sheets("Test")
'' Set up range for data from '82-Medicine'
lr = src_1.Cells(2, 1).End(xlDown).Row
lc = src_1.Cells(2, 1).End(xlToRight).Column
Set src_1_rng = src_1.Range(src_1.Cells(2, 1), src_1.Cells(lr, lc))
'' Set up range for data from 'FeeBasis'
lr = src_2.Cells(2, 1).End(xlDown).Row
lc = src_2.Cells(2, 1).End(xlToRight).Column
Set src_2_rng = src_2.Range(src_2.Cells(2, 1), src_2.Cells(lr, lc))
'' Copy the data to the destination sheet ('Test')
src_1_rng.Copy dest.Range("A" & dest.Rows.Count).End(xlUp).Offset(1)
src_2_rng.Copy dest.Range("A" & dest.Rows.Count).End(xlUp).Offset(1)
End Sub
Not sure why that wouldn't work but try this. I've never been a fan of CurrentRegion or selecting different sheets during code. Why bother when you can just use references? This should work perfectly.
edit
Changed the lr and lc variables to use xlDown from (2,1) and xlToRight from (2,1) to properly get a "CurrentRegion"-esque range.
I am trying to select each consecutive cell in Row K (starting from Range K1), and for each cell going down, copy the value and paste it into Cell M10. However, the way the macro is written currently, the macro is selecting the cell right below the last cell in Range K, and is thus copying a blank into M10. Instead, I want the loop to work down one cell at a time. I want to select one cell at a time and copy it, i.e. the Loop will select K1 and copy it to M10, then select K2 and copy it to M10, etc, and then have the loop stop after the last cell of Range K.
Can anyone please help me out on this?
Sub test()
lastcell = Range("K" & Cells.Rows.Count).End(xlUp)
Range("K2").Select
Do
ActiveCell.Offset(1, 0).Select
Selection.Copy
Range("M10").Select
Selection.PasteSpecial
Application.Run ("Second Macro")
Loop Until IsEmpty(ActiveCell.Value)
End Sub
You can loop through column K using the small script below:
Option Explicit
Sub LoopThroughColumnK()
Dim LastRowInColK As Long, Counter As Long
Dim SourceCell As Range, DestCell As Range
Dim MySheet As Worksheet
'set references up-front
Set MySheet = ThisWorkbook.Worksheets("Sheet1")
With MySheet
LastRowInColK = .Range("K" & .Rows.Count).End(xlUp).Row
Set DestCell = .Range("M10")
End With
'loop through column K, copying from cells(counter, 11) to M10
With MySheet
For Counter = 1 To LastRowInColK
Set SourceCell = .Range("K" & Counter)
SourceCell.Copy Destination:=DestCell
'call MyMacro below
'... doing cool MyMacro stuff
Next Counter
End With
End Sub
To summarize what's happening, we:
Assign a worksheet variable to make sure we're working on the right sheet
Assign easy-to-read and reference variables for the last row and cell M10
Loop through the range in question, copying and pasting from Kn to M10
This technique also avoids using .Select, a common source of run-time errors. Here's an AMAZING post outlining lots of ways to NOT use .Select and .Activate: How to avoid using Select in Excel VBA macros
Edit: The refactoring I described in my comment above could be implemented without too much struggle. Let's break the whole problem into two bite-size chunks:
Get all the occupied cells in column K and save them as a Range
Running your secondary macro, which was keyed off cell M10, for each Cell in the Range we saved in step #1 above. We'll call the secondary macro MyOtherMacro for now
Let's get after it. Sunday Funday y'all! The code below is heavily-commented to explain what's happening in each function and step:
Option Explicit
Sub DoWork()
Dim MySheet As Worksheet
Dim ColKRange As Range
'set the worksheet we want to work on, in this case "Sheet1"
Set MySheet = ThisWorkbook.Worksheets("Sheet1")
'get the range of occupied cells in col K
Set ColKRange = OccupiedRangeInColK(MySheet)
'kick off the other macro using the range we got in the step above
Call MyOtherMacro(ColKRange)
End Sub
DoWork (above) is a "controller"-type script. All it does is kick off the other two functions we have written below, OccupiedRangeInColK and then, one step later, MyOtherMacro.
'this function returns a range object representing all
'the occupied cells in column K, starting at row 1 and ending
'at the last occupied row (in column K)
Public Function OccupiedRangeInColK(TargetSheet As Worksheet) As Range
Dim LastRow As Long
'check for unassigned worksheet object, return nothing if that's the case
If TargetSheet Is Nothing Then
Set OccupiedRangeInColK = Nothing
End If
With TargetSheet
LastRow = .Range("K" & .Rows.Count).End(xlUp).Row
Set OccupiedRangeInColK = .Range(.Cells(1, 11), .Cells(LastRow, 11))
End With
End Function
Cool -- descriptive names are a great thing when it comes to scripting. OccupiedRangeInColK (above) takes a Worksheet, then returns the occupied Range from column K.
'this function is a shell to be populated by #polymorphicicebeam
Public Function MyOtherMacro(TargetRange As Range)
Dim Cell As Range
'check for an empty range, exit the function if empty
If TargetRange Is Nothing Then Exit Function
'loop through all the cells in the passed-in range
For Each Cell In TargetRange
'Do cool stuff in here. For demo purposes, we'll just
'print the address of the cell to the screen
MsgBox (Cell.Address)
Next Cell
End Function
Finally, MyOtherMacro (above) is where you get to add your own magic. I built a "shell" function for you, which simply prints the address of the cell in question with a MsgBox. You can add your own logic where indicated inside the For Each Cell In TargetRange loop. Woo!