Copy Values instead of formulas in an offset copy - excel

I am having trouble figuring out how to have my offset copy and paste code, copy values rather than formulas.
I have the following code which works perfectly but putting the copied cells in the next blank column, but I need the values, not formulas pasted in.
Sub Burndown_Snapshot()
'Copies the Overall Status Summary Data from the Dashboard and adds to the next empty column of the Historic Status table
'Triggered by the 'Burndown Snapshot' button on the dashboard
Dim column_number As Integer
column_number = Sheets("Historic Status").Cells.Find(What:="*", After:=Range("IV65536"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
Sheets("Dashboard").Range("C3:C7").Copy Destination:=Sheets("Historic Status").Cells(1, column_number)
End Sub
I figure i need a .PasteValues in there somewhere but im not sure where
Thanks

Copy Column Range
Set lCell = dws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious)
dws.Cells means all worksheet cells e.g. A1:XFD1048576, or A1:IV65536 for version prior to Office 2007.
The 2nd (omitted) argument (of the Find method) is After whose default parameter is Cells(1) or Cells("A1") i.e. the first cell of whichever range (dws.Cells) you apply the method to.
Combined with the xlPrevious parameter of the SearchDirection argument, it looks first in the last cell (e.g. XFD1048576).
By choosing the xlByColumns parameter of the SearchOrder argument, the next cell looked in will be XFD1048575 etc.
The xlFormulas parameter of the LookIn argument makes sure that the first non-empty cell is found (not ="" or "'", just empty (blank includes all three)).
The parameter of the 4th, the LookAt argument, is irrelevant and therefore omitted.
Set dCell = dws.Cells(1, lCell.Column + 1)
After the cell is found (Not lCell Is Nothing), we reference the cell (dCell)in the first row (1 before the comma) in lCell's column adjacent to the right (lCell.Column + 1)
Set drg = dCell.Resize(srg.Rows.Count, srg.Columns.Count)
The destination range has to be the same size as the source range to copy by assignment.
In this particular case, you can safely omit , srg.Columns.Count since there is only one column Set drg = dCell.Resize(srg.Rows.Count) (the default parameter of both arguments of the Resize method is 1.
Now you can copy values by assignment: drg.Value = srg.Value.
Sub Burndown_Snapshot()
'Copies the Overall Status Summary Data from the Dashboard and adds to the next empty column of the Historic Status table
'Triggered by the 'Burndown Snapshot' button on the dashboard
Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets("Dashboard")
Dim srg As Range: Set srg = sws.Range("C3:C7")
Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets("Historic Status")
Dim lCell As Range
Set lCell = dws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious)
If lCell Is Nothing Then Exit Sub ' no data in range
Dim dCell As Range: Set dCell = dws.Cells(1, lCell.Column + 1)
Dim drg As Range: Set drg = dCell.Resize(srg.Rows.Count, srg.Columns.Count)
drg.Value = srg.Value
End Sub

So I updated my code to include an extra copy paste function to give me the result I want, which also works, but requires a defined cut and paste range (which in most cases should be workable)
Sub Burndown_Snapshot2()
'Copies the Overall Status Summary Data from the Dashboard and adds to the next empty column of the Historic Status table
'Triggered by the 'Burndown Snapshot' button on the dashboard
Application.ScreenUpdating = False
Dim column_number As Integer
Dim rng As Range
column_number = Sheets("Historic Status").Cells.Find(What:="*", After:=Range("IV65536"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
Sheets("Dashboard").Range("C3:C7").Copy Destination:=Sheets("Historic Status").Cells(1, column_number)
For Each rng In Sheets("Historic Status").Range("B1:ZZ5")
If rng.Value <> "" Then
rng.Value = rng.Value
End If
Next rng
Application.ScreenUpdating = False
End Sub
However #VBasic2008s answer is much cleaner and doesn't have an arbitrary end point

Related

Excel VBA copy-paste only the visible filtered values from one column to another

I'm trying to copy-paste only the visible filtered (date) values from column "B" to column "Y". (In filtered condition I can only copy small portions of column "B" to "Y".)
I tried to do this with a the help of the below macro. This doesn't work unfortunately because it copies everything (also non filtered values) from column "B" to "Y" and I want to keep the non filtered data in "Y"
x = 4
Do While Cells(x, 1).Value <> ""
Cells(x, 25).Value = Cells(x, 2).Value
x = x + 1
Loop
I also tried variants like here below, but these copy also just a portion of column B or the code throws errors.
Range(Cells(4, 2), Cells(Range("B" & Rows.Count).End(xlDown).Row, 2)).SpecialCells(xlCellTypeVisible).Copy
ActiveSheet.Range (Cells(4, 25).PasteSpecial(xlPasteAll)) ' Range("Y4").PasteSpecial(xlPasteAll))
Does anyone have an idea how I can solve this? Thank you.
Copy Filtered Data to Another Column
Option Explicit
Sub CopyToY()
Dim ws As Worksheet: Set ws = ActiveSheet ' be more specific
' First Cell of the Data Range (in the row below headers)
Dim fCell As Range: Set fCell = ws.Range("B4")
' Last Cell of the Filtered Range
Dim lCell As Range: Set lCell = ws.Range("B" & ws.Rows.Count).End(xlUp)
' If no filtered data, the last cell will be the header cell, which
' is above the first cell. Check this with:
If lCell.Row < fCell.Row Then Exit Sub ' no filtered data
' Range from First Cell to Last Cell
Dim rg As Range: Set rg = ws.Range(fCell, lCell)
' Filtered Data Range
Dim frg As Range: Set frg = rg.SpecialCells(xlCellTypeVisible)
' Area Range
Dim arg As Range
For Each arg In frg.Areas
' Either copy values (more efficient (faster))...
arg.EntireRow.Columns("Y").Value = arg.Value
' ... or copy values, formulas and formatting
'arg.Copy arg.EntireRow.Columns("Y")
Next arg
MsgBox "Filtered data copied to column ""Y"".", vbInformation
End Sub

Why .SpecialCells().Count returns 1 always when there is no visible rows in the region?

I have an excel sheet (VBA - Office 2013) where I set up auto filters. Then my script reads a number of visible rows and copies that to another sheet.
With stacked_sheet
.AutoFilterMode = False
.Range("A1:I1000").AutoFilter Field:=6, Criteria1:=uBoards(b, 1)
.Range("A1:I1000").AutoFilter Field:=9, Criteria1:=uCombos(c, 1)
End With
'Counting number of rows post filtering based on Column 9 (boards)
filtered_row_count = stacked_sheet.Range("A2:I1000").Columns(9).SpecialCells(xlCellTypeVisible).Count
This script works as expected as far as there are records after the filter. However, when there are no records after the filter, 'filtered_row_count' always returns 1 instead of 0.
The following image shows the records post filter (no records)
Any help is appreciated.
I tried following variations too but none worked . . .
1. filtered_row_count = stacked_sheet.Range("A2:1000").Rows.SpecialCells(xlCellTypeVisible).Count
2. filtered_row_count = stacked_sheet.Range("A2:1000").Columns.SpecialCells(xlCellTypeVisible).Count
3. filtered_row_count = stacked_sheet.Range("A2:1000").Cells.SpecialCells(xlCellTypeVisible).Count
Copy SpecialCells (WorksheetFunction.SubTotal)
Links (Microsoft)
VBA: Range.SpecialCells method (Excel)
VBA: WorksheetFunction.Subtotal method (Excel)
Excel: SUBTOTAL function
Tips
Create the necessary range references before applying the filter.
If you're filtering by a non-blank value, you can use WorksheetFunction.SubTotal to count the number of filtered cells, but you want to do it in one column (the filter column (Field)) of the Data Range, the range without headers. Note that you can always do it the 'On Error Resume Next way' (second example).
After you have determined that the number of cells is greater than 0, you can continue to copy with .SpecialCells(xlCellTypeVisible) applied to the Data Range, or applied to the whole range if you need the headers copied.
Some of the range references in these examples may be redundant but are left in the code to better understand what should be considered. Once you decide which way to go, remove the redundant references.
In the second example, the focus is on getting the number of cells. In the On Error... block of code, you would usually go with Set sfdrg = sdrg.SpecialCells(xlCellTypeVisible), because you don't care about the exact number of cells. You only need to know if there is any number of cells, which is determined by If Not sfdcrg Is Nothing Then (usually If Not sfdrg Is Nothing Then).
Option Explicit
Sub FilterRangeSubTotal()
Dim srg As Range ' Source Range
Dim sdrg As Range ' Source Data Range (Source Range Without Headers)
Dim sfdrg As Range ' Source Filtered Data Range
Dim sdcrg As Range ' Source Data Column Range
Dim sfdcrg As Range ' Source Filtered Data Column Range
With StackedSheet
If .AutoFilterMode Then .AutoFilterMode = False
Set srg = .Range("A1:I1000")
Set sdrg = srg.Resize(srg.Rows.Count - 1).Offset(1) ' "A2:I1000"
' To be able to use 'WorksheetFunction.SubTotal', pick the column
' where values in all filtered cells are ensured,
' i.e. where you do not filter by blanks e.g.:
Set sdcrg = sdrg.Columns(9) ' "I2:I1000"
End With
srg.AutoFilter Field:=6, Criteria1:=uBoards(b, 1) ' ???
srg.AutoFilter Field:=9, Criteria1:=uCombos(c, 1) ' ???
Dim FilteredCellsCount As Long
FilteredCellsCount = WorksheetFunction.Subtotal(103, sdcrg) ' COUNTA
If FilteredCellsCount > 0 Then
'Set sfdrg = sdrg.SpecialCells(xlCellTypeVisible)
'sfdrg.Copy AnotherSheet.Range("A2")
Set sfdcrg = Nothing
'Else 'FilteredCellsCount = 0
End If
StackedSheet.AutoFilterMode = False
MsgBox "Filtered Cells Count: " & FilteredCellsCount
End Sub
Sub FilterRangeOnErrorResumeNext()
Dim srg As Range ' Source Range
Dim sdrg As Range ' Source Data Range (Source Range Without Headers)
Dim sfdrg As Range ' Source Filtered Data Range
Dim sdcrg As Range ' Source Data Column Range
Dim sfdcrg As Range ' Source Filtered Data Column Range
With StackedSheet
If .AutoFilterMode Then .AutoFilterMode = False
Set srg = .Range("A1:I1000")
Set sdrg = srg.Resize(srg.Rows.Count - 1).Offset(1) ' "A2:I1000"
Set sdcrg = sdrg.Columns(9) ' "I2:I1000", but you can pick any (valid)
End With
srg.AutoFilter Field:=6, Criteria1:=uBoards(b, 1) ' ???
srg.AutoFilter Field:=9, Criteria1:=uCombos(c, 1) ' ???
' 'Rows.Count' will not work because the range is possibly non-contiguous
' and only the rows of the first area will be considered.
' So you have to use 'Cells.Count' in one column only (sdcrg).
' It will never be 0, because if no cell, an error will occur.
On Error Resume Next
Dim sfdcrg As Range: Set sfdcrg = sdcrg.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
Dim FilteredCellsCount As Long
If Not sfdcrg Is Nothing Then
FilteredCellsCount = sfdcrg.Cells.Count ' not 'sfdcrg.rows.count'
'Set sfdrg = sdrg.SpecialCells(xlCellTypeVisible)
'sfdrg.Copy AnotherSheet.Range("A2")
Set sfdcrg = Nothing
'Else
'FilteredCellsCount = 0
End If
StackedSheet.AutoFilterMode = False
MsgBox "Filtered Cells Count: " & FilteredCellsCount
End Sub
The fix is to change (A2:I1000) to (A1:I1000)
filtered_row_count = stacked_sheet.Range("A1:I1000").Columns(9).SpecialCells(xlCellTypeVisible).Count
The chosen solution below describes it in detail.

VBA Extract Unique Values with Advance Filter From One Worksheet to Another

So I have this Workbook contains several worksheets.
In Sheet22 is a database and I need to extract unique values from one of its columns, which is Column "BC" (or Col 55).
here is to illustrate the unique values that I want to extract:
I need to extract the unique values to another worksheet (Sheet 32) starts from Range A1. But before that, I need to clear the target range first if it is not empty, then after that, paste the unique values.
so this is the codes I used, (fyi I'm, still new to VBA, so I found this code to be the closest to what I have in mind and modified it):
Option Explicit
Sub uniqueValuesFromRangeCustomer()
Dim rngCollectFrom As Range, targetRange As Range
Dim lastRow As Long
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet22")
'Set the target range where the unique values will be copied to
Set targetRange = Sheets("Sheet32").Range("A1")
'Clear the target range if it is not empty
If targetRange <> vbNullString Then
'Find last row in target range column
lastRow = Sheets("Sheet32").Columns(targetRange.Column).Find("*", , , , xlByRows, xlPrevious).Row
'Delete target range
Sheets("Sheet32").Range(targetRange, Cells(lastRow, targetRange.Column)).Delete xlUp
'Reset target range (since it gets deleted)
Set targetRange = Sheets("Sheet32").Range("A1")
End If
'Define the range the unique values will be extracted from
'Find last row
lastRow = Sheets("Sheet22").Columns(55).Find("*", , , , xlByRows, xlPrevious).Row
'Set the source range
Set rngCollectFrom = Sheets("Sheet22").Range(Cells(2, 55), Cells(lastRow, 55))
'Use Advanced Filter
rngCollectFrom.AdvancedFilter Action:=xlFilterCopy, copytorange:=targetRange, unique:=True
When I run the code, I got error message: "Subscript out of range", and when I debug, it highlights the code:
Set sh: ThisWorkbook.Sheets("Sheet22")
I still don't understand how to modify this code to works, please someone if can help me with this problem.
Thanks before!

Last Row in Range

Having an issue finding information and/or solutions that produce the desired result, so here it goes.
Right now, and potentially at production time, i will have a "template" named-range on a worksheet. On first use this NamedRange is only rngNamed1 but after the first use there could be more Named Ranges similar to this one, say up to rngNamed30.
Lets say on the 2nd run after building up to rngNamed30, that i need to add 3 more of the NamedRange, which results in rngNamed33.
What i need to do is basically find the last row & column of the last Named Range, so i know where to start the copying of data to and declare the next Named Range.
What i have tried so far:
Dim rng As range
Set rng = range("rngNamed1")
'Set rng = rng.Find("*", rng.Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False)
Debug.Print rng.Find("*", rng.Cells(1, 1), , , , xlPrevious).Address
The problem with most of the solutions out there is they are based on finding the last cell WITH DATA. I just need to know the Last Cell of the Range, irregardless of whether it contains data or not.
You can do this easily using the Row and Rows.Count of the range:
Sub NextRowAfterRange()
Dim ws As Worksheet
Dim rangeNom As String
Dim nextRow As Long
' Enter desired name here
rangeNom = "rngName1"
Set ws = ActiveSheet
nextRow = ws.Range(rangeNom).Row + ws.Range(rangeNom).Rows.Count
MsgBox nextRow
End Sub

Select all data in sheet

I am writing a macro that opens a New Workbook and copies all data to a different Workbook.
The data always starts on C12 but we dont always know how many rows of data there are
The following code is giving an error:
Workbooks("Somesheet.xls").Activate
Sheets("Sheet1").Activate
With Range("C12").Select
End (xlDown)
End With
How do I select all rows from C12?
dim rng as range
with Workbooks("Somesheet.xls").Sheets("Sheet1").range("C12")
set rng = range(.cells(0,0), .end(xldown))
end with
You could also use
set rng = Workbooks("Somesheet.xls").range("C12").CurrentRegion
I use Find to detect the true last used cell as UsedRange can be unreliable with over- estimating the extent of the true used range unless it is forced to recalc in the code before being used. UsedRange can also be problematic unless it start from A1 (I had this issue with Rachel's code when testing data only in C12:C40, the answer provided was G34:G60)
From your question sample code it appears you only wanted column C data from C12 down (which is what this code does). It can readily be extended accross the true used range of columns, or as entire rows if needed
Sub GetData()
Dim wb As Workbook
Dim ws As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Set wb = Workbooks("SomeSheet.xlsm")
Set ws = wb.Sheets("Sheet1")
Set rng1 = ws.Columns("C").Find("*", ws.[c1], xlFormulas, , , xlPrevious)
If rng1.Row > 12 Then
Set rng2 = ws.Range(ws.[c12], rng1)
MsgBox "Your range is " & rng2.Address(0, 0)
Else
MsgBox "Last row in " & ws.Name & " was only " & rng1.Row
End If
End Sub
In order to select all data from cell C12 down, use the UsedRange property to find the absolute last row used. Other methods will stop before the true end of the sheet if there is a blank cell in Column C. This snippet sets a Range variable that spans from C12 to the last used cell in the sheet:
Dim rng As Range
Dim lRowLast As Long, lColLast As Long
With ActiveWorkbook.Worksheets("Sheet1")
lRowLast = .UsedRange.Row + .UsedRange.Rows.Count - 1
lColLast = .UsedRange.Column + .UsedRange.Columns.Count - 1
Set rng = .Range(.Range("C12"), .Cells(lRowLast, lColLast))
End With
Note: use .Row + .Rows.Count - 1 to handle cases where the used range starts after the first row.
Edit: Updated example to fix the bug that #brettdj pointed out.

Resources