I have the following code in a macro but when I run it, it only copies the value from cell B2 rather than the entire range of values from B2:D2 as I have specified in line 5 of the below code.
Sub copying()
Dim calval as variant
With worksheets("sheet1")
Set calval=.Cells(Rows.Count,"B").End(xlUp).Offset(2,3)
calval.value=Range("B2:D2").Value 'copy range of values
End With
End Sub
This is the data in cells B2:D2
21.7 21.3 22.4
Can someone please tell me how to get calval to be assigned the full range of values from B2:D2, rather than just the value in B2.
You have a few problems here. Firstly when copying to variants, they are not objects so you don't need to use set. They also don't have ranges as they variables. You also need to copy the value to a variant before you can set it to the output range so the order is a little off. The following code will work:
Sub Copying()
Dim calval as Variant
'Read it in from the worksheet
With Worksheets("Sheet1")
calval=.Range("B2:D2").value
'Set it back to the dsired range using the bounds of the variant instead of hardcoding.
.Range(.Cells(Rows.Count,"B").End(xlUp).Offset(2,3), .Cells(Rows.Count,"B").End(xlUp).Offset(1 + UBound(calval, 1), 2 + UBound(calval, 2))).Value = calval
End With
End Sub
I understand you have accepted an answer, here is another method to achieve what you need: Using WorkSheetFunction.Transpose method.
Dim calval as Variant
'--- Range("B2:D2").Value
calval = WorkSheetFunction.Transpose(Sheets(1).Range("B2:D2").Value)
You are free to use, offset, resize according to your needs.
e.g. expand your range up to B12
calval = WorkSheetFunction.Transpose(Sheets(1).Range("B2:D2").Resize(10).Value)
Related
I am having difficulty looping through each column before looping through the next row. The number of columns is fixed (A:K) with an unknown number of rows. The goal is to find highlighted cells (no distinct color.. and I figured the best way to do this is to code "If Not No Fill") and copy that whole row to another workbook. This is what I have so far and I am stuck:
Option Explicit
Sub Approval_Flow()
Dim AppFlowWkb As Workbook, ConfigWkb As Workbook
Dim AppFlowWkst As Worksheet, ConfigWkst As Worksheet
Dim header As Range, headerend As Range
Dim row As Long, column As Long
Set AppFlowWkb = Workbooks.Open("C:\Users\clara\Documents\Templates and Scripts\Approval Flow Change Log.xlsx")
Set ConfigWkb = ThisWorkbook
Set AppFlowWkst = AppFlowWkb.Sheets("Editor")
Set ConfigWkst = ConfigWkb.Worksheets("Approval Flows")
With ConfigWkb
Set header = Range("A7").Cells
If Not header Is Nothing Then
Set headerend = header.End(xlDown).row
For row = 7 To headerend
For j = 1 To 11
'if cell is filled (If Not No Fill), copy that whole row to another workbook
End With
End Sub
I am getting an error with the Set headerend line, but I am trying to select the last row to use it in my for loop. I appreciate any help and guidance. Thanks in advance!
You should be able to adapt this to suit your workbooks, see the comments for details
Dim aCell as Range
' Use UsedRange to get the variable number of rows,
' cycle through all the cells in that range
For Each aCell In ActiveSheet.Range("A1:K" & ActiveSheet.UsedRange.Rows.Count)
' Test if fill colour is white (none)
If Not aCell.Interior.Color = RGB(255,255,255) Then
' Insert new row in target sheet (could find last row instead)
ActiveWorkbook.Sheets("ThisOtherSheet").Range("A1").EntireRow.Insert
' Paste entire row into target sheet
aCell.EntireRow.Copy Destination:=ActiveWorkbook.Sheets("ThisOtherSheet").Range("A1")
End If
Next aCell
Alternatively to find the last row, if you know the range is continuous (no blanks) then you can use End(xlDown) like you had done, and like below
For Each aCell In ActiveSheet.Range("A1:K" & ActiveSheet.Range("K1").End(xlDown))
I'd guess you don't want to copy the same row multiple times if you've already copied it. You could do this by keeping an array or string with previously copied row numbers and checking before copying again, or use Excel's unique functions to strip the list down after copying.
Hope this helps.
Aside:
You're using a With block but not taking advantage of it, you need to put a dot . before your Range objects to specify that they're in your With sheet. Like so
Dim myRange as Range
With ActiveSheet
Set myRange = .Range("A1:C10")
End With
You're mixing the types.
It looks like you just want to use the Row that the Header data ends on.
Take out the .Row there, since you're setting headerend to be a cell address, not a specific value. Then change For row = 7 To headerend to For row = 7 To headerend.Row
Or, change Dim Headerend as Range to ...as Long and just do headerEnd = header.End(xlDown).Row (don't use Set)
The variable tablelength counts how many items are in a table of mine. I want to select my entire table, but it varies in sizes so my range has to include a variable. I've googled a lot and searched this site (Using variables in Excel range <- that method looked promising but didn't work). Below is a snippet of my code, but includes everything that is relevant.
Private Sub CommandButton1_Click()
Dim shSource As Worksheet
Dim shDest As Worksheet
Dim tablelength As Integer
Set shDest = ThisWorkbook.Sheets("Sheet2")
'here comes some code that determines the value of tablelength, which is 8 in this case
shDest.Range("L" & "4" & ":" & "M" & tablelength).Select
End Sub
I appreciate the help.
edit: the debugger highlights the shDest.Range code.
Unless you need tablelength variable somewhere else in the code, you could try using:
shDest.Range("L4").CurrentRegion.Select
CurrentRegion.Select will select all cells starting from "L4" until it reaches a blank row and column, so providing your tables are surrounded by blank cells this should select the whole table regardless of the size
Here you go, try this:
ActiveSheet.Range(Cells(2, 3), Cells(10, 4)).Select
Taken from http://support.microsoft.com/kb/291308
The first parameter to Cells is the row and the second is the column as a number.
So for you it would look something like this:
shDest.Range(Cells(4, 12), Cells(tablelength, 13)).Select
If it's a proper Table on the spreadsheet, and not just cells formatted to look like a table, you can directly refer to the 'live' size of the table in your code without jumping through all these hoops.
In your VBA code,
The 'Table' is referred to as a ListObject
You can declare a new ListObject, and look up its DataBodyRange.Rows.Count
This should work:
Sub MyMacro()
Dim Tabl As ListObject
Set Tabl = Worksheets("Sheet1").ListObjects("Table1")
MsgBox Tabl.DataBodyRange.Rows.Count
End Sub
You can also set a range variable to refer to the 'Data' range. You need to use the following code.
Dim Rng As Range
Set Rng = Worksheets("Sheet1").ListObjects("Table1").DataBodyRange
Now Rng.Cell(1,1) or Rng.Range("A1") refers to the top left cell of the data body and so on and so forth...
I have already created a VBA script that is about 160 lines long, which produces the report that you see below.
Without using cell references (because the date ranges will change each time I run this) I now need to take the users ID, name, total hours, total break, overtime 1, and overtime 2 and copy this data into sheet 2.
Any suggestions as to how I can structure a VBA script to search row B until a blank is found, when a blank is found, copy the values from column J, K, L, M on that row, and on the row above copy value C - now paste these values on sheet 2. - Continue this process until you find two consecutive blanks or the end of the data...
Even if you can suggest a different way to tackle this problem than the logic I have assumed above it would be greatly appreciated. I can share the whole code if you are interested and show you the data I began with.
Thank you in advance,
J
As discussed, here's my approach. All the details are in the code's comments so make sure you read them.
Sub GetUserNameTotals()
Dim ShTarget As Worksheet: Set ShTarget = ThisWorkbook.Sheets("Sheet1")
Dim ShPaste As Worksheet: Set ShPaste = ThisWorkbook.Sheets("Sheet2")
Dim RngTarget As Range: Set RngTarget = ShTarget.UsedRange
Dim RngTargetVisible As Range, CellRef As Range, ColRef As Range, RngNames As Range
Dim ColIDIndex As Long: ColIDIndex = Application.Match("ID", RngTarget.Rows(1), 0)
Dim LRow As Long: LRow = RngTarget.SpecialCells(xlCellTypeLastCell).Row
'Turn off AutoFilter to avoid errors.
ShTarget.AutoFilterMode = False
'Logic: Apply filter on the UserName column, selecting blanks. We then get two essential ranges.
'RngTargetVisible is the visible range of stats. ColRef is the visible first column of stats.
With RngTarget
.AutoFilter Field:=ColIDIndex, Criteria1:="=", Operator:=xlFilterValues, VisibleDropDown:=True
Set RngTargetVisible = .Range("J2:M" & LRow).SpecialCells(xlCellTypeVisible)
Set ColRef = .Range("J2:J" & LRow).SpecialCells(xlCellTypeVisible)
End With
'Logic: For each cell in the first column of stats, let's get its offset one cell above
'and 7 cells to the left. This method is not necessary. Simply assigning ColRef to Column C's
'visible cells and changing below to CellRef.Offset(-1,0) is alright. I chose this way so it's
'easier to visualize the approach. RngNames is a consolidation of the cells with ranges, which we'll
'copy first before the stats.
For Each CellRef In ColRef
If RngNames Is Nothing Then
Set RngNames = CellRef.Offset(-1, -7)
Else
Set RngNames = Union(RngNames, CellRef.Offset(-1, -7))
End If
Next CellRef
'Copy the names first, then RngTargetVisible, which are the total stats. Copying headers is up
'to you. Of course, modify as necessary.
RngNames.Copy ShPaste.Range("A1")
RngTargetVisible.Copy ShPaste.Range("B1")
End Sub
Screenshots:
Set-up:
Result:
Demo video here:
Using Filters and Visible Cells
Let us know if this helps.
Could someone please help me with some VBA code.
I am trying to copy 2 ranges of cells between workbooks (both workbooks should be created beforehand as i don't want the code to create a new workbook on the fly).
Firstly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell H5 to the last row in column H with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell B2 for as many cells down in the B column
Secondly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell K5 to the last row in column K with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell D2 for as many cells down in the D column
Here is what I have so far:
Sub CopyDataBetweenBooks()
Dim iRow As Long
Dim wksFr As Worksheet
Dim wksTo As Worksheet
wksFr = "C:\booka.xls"
wksTo = "C:\bookb.xls"
Set wksFrom = Workbooks(wksFr).Worksheets("Sheet 3")
Set wksTo = Workbooks(wksTo).Worksheets("Sheet 1")
With wksFrom
For iRow = 1 To 100
.Range(.Cells(iRow, 8), .Cells(iRow, 9)).Copy wksTo.Cells(iRow, 8)
Next iRow
End With
End Sub
Assuming you have the reference to wksFrom and wksTo, here is what the code should be
wksFrom.Range(wksFrom.Range("H5"), wksFrom.Range("H5").End(xlDown)).Copy wksTo.Range("B2")
wksFrom.Range(wksFrom.Range("K5"), wksFrom.Range("K5").End(xlDown)).Copy wksTo.Range("D2")
Here's an example of how to do one of the columns:
Option Explicit
Sub CopyCells()
Dim wkbkorigin As Workbook
Dim wkbkdestination As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim lastrow As Integer
Set wkbkorigin = Workbooks.Open("booka.xlsm")
Set wkbkdestination = Workbooks.Open("bookb.xlsm")
Set originsheet = wkbkorigin.Worksheets("Sheet3")
Set destsheet = wkbkdestination.Worksheets("Sheet1")
lastrow = originsheet.Range("H5").End(xlDown).Row
originsheet.Range("H5:H" & lastrow).Copy 'I corrected the ranges, as I had the src
destsheet.Range("B2:B" & (2 + lastrow)).PasteSpecial 'and destination ranges reversed
End Sub
As you have stated in the comments, this code above will not work for ranges with spaces, so substitute in the code below for the lastrow line:
lastrow = originsheet.range("H65536").End(xlUp).Row
Now ideally, you could make this into a subroutine that took in an origin workbook name, worksheet name/number, and range, as well as a destination workbook name, worksheet name/number, and range. Then you wouldn't have to repeat some of the code.
You can use special cells like Jonsca has suggested. However, I usually just loop through the cells. I find it gives me more control over what exactly I am copying. There is a very small effect on performance. However, I feel that in the office place, making sure the data is accurate and complete is the priority. I wrote a response to a question similar to this one that can be found here:
StackOverflow - Copying Cells in VBA for Beginners
There is also a small demonstration by iDevelop on how to use special cells for the same purpose. I think that it will help you. Good luck!
Update
In response to...
good start but it doesn't copy anything after the first blank cell – trunks Jun 9 '11 at 5:08
I just wanted to add that the tutorial in the link above will address the issue brought up in your comment. Instead of using the .End(xlDown) method, loop through the cells until you reach the last row, which you retrieve using .UsedRange.Rows.Count.
I have a small script in Excel/VB that I'm trying to get working. All I want to do is select a dynamic range of data to copy but I can't seem to find any help/code on how to get the grid data (like A11).
Here is code I have from macro recording that selects the range of data:
Range("D291:D380").Select
I was hoping I could just do Range(Current).Select or something but that doesn't work.
How do I get the current cell using VBA?
Have you tried:
For one cell:
ActiveCell.Select
For multiple selected cells:
Selection.Range
For example:
Dim rng As Range
Set rng = Range(Selection.Address)
This may not help answer your question directly but is something I have found useful when trying to work with dynamic ranges that may help you out.
Suppose in your worksheet you have the numbers 100 to 108 in cells A1:C3:
A B C
1 100 101 102
2 103 104 105
3 106 107 108
Then to select all the cells you can use the CurrentRegion property:
Sub SelectRange()
Dim dynamicRange As Range
Set dynamicRange = Range("A1").CurrentRegion
End Sub
The advantage of this is that if you add new rows or columns to your block of numbers (e.g. 109, 110, 111) then the CurrentRegion will always reference the enlarged range (in this case A1:C4).
I have used CurrentRegion quite a bit in my VBA code and find it is most useful when working with dynmacially sized ranges. Also it avoids having to hard code ranges in your code.
As a final note, in my code you will see that I used A1 as the reference cell for CurrentRegion. It will also work no matter which cell you reference (try: replacing A1 with B2 for example). The reason is that CurrentRegion will select all contiguous cells based on the reference cell.
The keyword "Selection" is already a vba Range object so you can use it directly, and you don't have to select cells to copy, for example you can be on Sheet1 and issue these commands:
ThisWorkbook.worksheets("sheet2").Range("namedRange_or_address").Copy
ThisWorkbook.worksheets("sheet1").Range("namedRange_or_address").Paste
If it is a multiple selection you should use the Area object in a for loop:
Dim a as Range
For Each a in ActiveSheet.Selection.Areas
a.Copy
ThisWorkbook.worksheets("sheet2").Range("A1").Paste
Next
Regards
Thomas
If you're trying to grab a range with a dynamically generated string, then you just have to build the string like this:
Range(firstcol & firstrow & ":" & secondcol & secondrow).Select
I realize this doesn't directly apply from the title of the question, However some ways to deal with a variable range could be to select the range each time the code runs -- especially if you are interested in a user-selected range. If you are interested in that option, you can use the Application.InputBox (official documentation page here). One of the optional variables is 'type'. If the type is set equal to 8, the InputBox also has an excel-style range selection option. An example of how to use it in code would be:
Dim rng as Range
Set rng = Application.InputBox(Prompt:= "Please select a range", Type:=8)
Note:
If you assign the InputBox value to a none-range variable (without the Set keyword), instead of the ranges, the values from the ranges will be assigned, as in the code below (although selecting multiple ranges in this situation may require the values to be assigned to a variant):
Dim str as String
str = Application.InputBox(Prompt:= "Please select a range", Type:=8)
Try this
Dim app As Excel.Application = Nothing
Dim Active_Cell As Excel.Range = Nothing
Try
app = CType(Marshal.GetActiveObject("Excel.Application"), Excel.Application)
Active_Cell = app.ActiveCell
Catch ex As Exception
MsgBox(ex.Message)
Exit Sub
End Try
' .address will return the cell reference :)