I am trying to write a macro which will find a value "Spot price" in a header of a table2 and then take the whole column where that value is to copy and paste it (as values and not formulas). I need to do it because in that column I have a reference to external workbook and I need to share this worksheet without sharing the other workbook. This is what I wrote
Sub row()
Dim firstrow As Range
Dim ColumnToPaste As Range
Dim copy As Range
Set firstrow = Worksheets("Raw Data").ListObjects("Table2").HeaderRowRange
Set ColumnToPaste = firstrow.Find("Spot price", , xlValues, xlWhole).Columns(1)
With Worksheets("Raw Data").Range(ColumnToPaste)
.PasteSpecial Paste:=xlPasteValues
End With
End Sub
The error occurs on this line (Application-defined or object-defined error):
With Worksheets("Raw Data").Range(ColumnToPaste)
I think I'm using wrong range argument but not sure how to write it properly.
How about the following, instead of copying the full column, specify the range:
Sub row2()
Dim ws As Worksheet: Set ws = Sheets("Raw Data")
'declare and set your worksheet, amend as required
Dim firstrow As Range
Dim ColumnToPaste As Range
Dim LastRow As Long
Set firstrow = ws.ListObjects("Table2").HeaderRowRange
Set ColumnToPaste = firstrow.Find("Spot price", , xlValues, xlWhole).Columns
col = ColumnToPaste.Column
LastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
'get the last row with data on Column A
With ws
.Range(.Cells(1, col), .Cells(LastRow, col)).Copy
.Range(.Cells(1, col), .Cells(LastRow, col)).PasteSpecial xlPasteValues
End With
End Sub
Related
My question is very similar to the following:
Excel VBA code to select non empty cells
However, I have some empty cells in between. In particular, I'm trying to define a range where the first row needs to be excluded, since it's a header. I also have to exclude the empty cells that follow. I was trying something like
Dim wb as workbook, ws as worksheet
Dim myrange as range
'Defined reference wb and ws
myrange=ws.range("B2",range("B2"),end(xldown))
But this only works if there are not empty cells in between. So, is there a fast and simple way to dynamically select a range that includes non-empty cells, excepted the header?
Try this
'Defined reference wb and ws
Set myrange = ws.range("B2", ws.Range("B" & Rows.Count).End(xlUp))
Don't forget to use the Set keyword
Try the next way, please:
Sub testDefineRange()
Dim ws As Worksheet, lastRow As Long, myrange As Range
Set ws = ActiveSheet 'use here what you need
lastRow = ws.Range("B" & ws.rows.count).End(xlUp).row
'Defined reference ws
Set myrange = ws.Range("B2:B" & lastRow)
myrange.Select
End Sub
I have found this link to be very useful on MANY occasions.
https://www.thespreadsheetguru.com/blog/2014/7/7/5-different-ways-to-find-the-last-row-or-last-column-using-vba
Ways To Find The Last Row
Sub FindingLastRow()
'PURPOSE: Different ways to find the last row number of a range
'SOURCE: www.TheSpreadsheetGuru.com
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ActiveSheet
'Using Find Function (Provided by Bob Ulmas)
LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'Using SpecialCells Function
LastRow = sht.Cells.SpecialCells(xlCellTypeLastCell).Row
'Ctrl + Shift + End
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
'Using UsedRange
sht.UsedRange 'Refresh UsedRange
LastRow = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row
'Using Table Range
LastRow = sht.ListObjects("Table1").Range.Rows.Count
'Using Named Range
LastRow = sht.Range("MyNamedRange").Rows.Count
'Ctrl + Shift + Down (Range should be first cell in data set)
LastRow = sht.Range("A1").CurrentRegion.Rows.Count
End Sub
Ways To Find The Last Column
Sub FindingLastColumn()
'PURPOSE: Different ways to find the last column number of a range
'SOURCE: www.TheSpreadsheetGuru.com
Dim sht As Worksheet
Dim LastColumn As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
'Ctrl + Shift + End
LastColumn = sht.Cells(7, sht.Columns.Count).End(xlToLeft).Column
'Using UsedRange
sht.UsedRange 'Refresh UsedRange
LastColumn = sht.UsedRange.Columns(sht.UsedRange.Columns.Count).Column
'Using Table Range
LastColumn = sht.ListObjects("Table1").Range.Columns.Count
'Using Named Range
LastColumn = sht.Range("MyNamedRange").Columns.Count
'Ctrl + Shift + Right (Range should be first cell in data set)
LastColumn = sht.Range("A1").CurrentRegion.Columns.Count
End Sub
If it suits your case, I like to use CurrentRegion with Intersect to eliminate the title row.
with ws.range("b2")
set myRange = intersect(.currentregion, .currentregion.offset(1,0))
end with
debug.print myRange.address
I'm trying to use VBA to find the Sheet1 column header “Country”, and copy it along with the 20 columns to the right of it, to to Sheet2 column A
I have tried:
Dim lr As Long, lc As Long, Col as Long
With ThisWorkbook.Worksheets("Sheet1")
Col = Application.Match("Country", Sheets("Sheet1").Rows(1), 0)
lr = .Cells(Rows.Count, 1).End(xlUp).Row
lc = .Cells(1, Columns.Count).End(xlToRight).Column
With .Cells (lr, 20).Copy Destination:= Sheets("Sheet2"). Column (“A:A”)
End With
End With
Here's your code, refactored and pointing out the issues in comments
Sub Demo()
Dim lr As Long
'lc not used, left out
Dim Col As Variant 'allow for possibility Country is not found
With ThisWorkbook.Worksheets("Sheet1")
' Use the with block
' Sheets("Sheet1") may or may not be the same sheet as ThisWorkbook.Worksheets("Sheet1")
'Col = Application.Match("Country", Sheets("Sheet1").Rows(1), 0)
Col = Application.Match("Country", .Rows(1), 0)
' Allow for possibility Country is not found
If Not IsError(Col) Then
' Rows.Count refers to the ActiveSheet,
' which may or may not have the same number of rows as ThisWorkbook.Worksheets("Sheet1")
' You are also assuming that Column A has at least the number of rows as your data.
' Is this what you want?
'lr = .Cells(Rows.Count, 1).End(xlUp).Row
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
' Specify the source range, starting at row 1, column containing Country
' then resize to the required size: lr rows, 21 columns
' Specify destination as top left cell, on the fully qualified sheet
.Cells(1, Col).Resize(lr, 21).Copy Destination:=ThisWorkbook.Worksheets("Sheet2").Cells(1, 1)
' Alternative, if you don't need to copy formatting.
'Dim r As Range
'Set r = .Cells(1, Col).Resize(lr, 21)
'ThisWorkbook.Worksheets("Sheet2").Cells(1, 1).Resize(r.Rows.Count, r.Columns.Count).Value _
' = r.Value
End If
End With
End Sub
Find header with text "Country" (I'm assuming your header is in Row 1)
Once found, Copy the "Country" column and 19 columns to right
Paste in Sheet2 A1
Sub ColumnHunt()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim pr As Range: Set pr = ThisWorkbook.Sheets("Sheet2").Range("A1") 'pr = Paste Range
Dim lr As Long, Found As Range
lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Set Found = ws.Cells(1, 1).EntireRow.Find("Country")
If Not Found Is Nothing Then
ws.Range(ws.Cells(1, Found.Column), ws.Cells(lr, Found.Column + 20)).Copy pr
Else
MsgBox "Country Column Not Found", vbCritical
End If
End Sub
I hope my following code (with some comments) will help
Option Explicit
Private Sub CommandButton1_Click()
' Get the last Row Number of your Data
Dim myLastRow As Integer
myLastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
' Get the Column Number of your Header Name = "Country"
Dim myHeaderString As String
Dim myHeaderCell As Range
myHeaderString = "Country"
Set myHeaderCell = Sheet1.Rows(1).Find(What:=myHeaderString, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
' Be sure that we find that column, send an error message if NOT
If Not myHeaderCell Is Nothing Then
' Get your Source Data Range
Dim myColumnNo As Integer
myColumnNo = myHeaderCell.Column
Dim myRange As Range
Set myRange = Sheet1.Range(Sheet1.Cells(1, myColumnNo), Sheet1.Cells(myLastRow, myColumnNo + 20))
' Copy The Source Data Range
Sheet1.Activate
myRange.Copy
' Past to the Target location
Sheet2.Activate
Sheet2.Cells(1, 1).Select
Sheet2.Paste
Else
MsgBox "No Column Header found"
End If
End Sub
I'm trying to copy data from sheet "DATEV_RAB_UNVERBINDLICH", Range D2:D to sheet "Ready to upload", Range B2:B.
I would like find data to the last row and then copy them into the other sheet. I have this code:
Sub CopyInvoiceNo()
Dim ws, ws1 As Worksheet
Dim lastrow As Long
lastrow = .Cells(.Rows.Count, "D").End(xlUp).Row
Set ws = Sheets("DATEV_RAB_UNVERBINDLICH")
Set ws1 = Sheets("Ready to upload")
ws.Range("D2" & lastrow).Copy
ws1.Range("B4").PasteSpecial xlPasteValues
ws1.Activate
End Sub
But I receive error msg Invalid or unqualified reference. Could you advise me, what do I do wrong, please?
Two errors in your code
At line 3, this is not the correct way to define multiple variable types in the same line. You have to define each of them.
At line 10, lets say your lastrow is "20". It would set the range to "D220", which is also not what you want.
Sub CopyInvoiceNo()
Dim ws As Worksheet, ws1 As Worksheet
Dim lastrow As Long
Set ws = Sheets("DATEV_RAB_UNVERBINDLICH")
Set ws1 = Sheets("Ready to upload")
lastrow = ws.Cells(Rows.count, 4).End(xlUp).Row
ws.Range("D2:D" & lastrow).Copy
ws1.Range("B4").PasteSpecial xlPasteValues
ws1.Activate
End Sub
I also changed to define the variables and its values at the start of the code. The lastrow bit didn't code here too after a bit of testing. Now it works for me at least.
I am fairly new in excel VBA and would really appreciate any help on this matter.
The workbook includes data from range A5:AZ1000 (new client info is inputted in new rows, but some cells may be empty depending on the nature of the case). When a user inputs new client info (begins a new row) I would like the existing data (range A5:AZ1000) to shift down one row, and a blank row to appear in range A5:AZ:5. I would like users to be able to click a macro "New Client" for this to happen.
It should be noted that this is a shared workbook and therefore I cannot have macro that adds a new row.
Here is the code I'm working with:
Sub shiftdown()
' shiftdown Macro
Dim lastRow As Long
Dim lastColumn As Long
Dim rngToCopy As Range
Dim rng As Range
Set rng = ActiveSheet.Range("A1").Value
lastColumn = ActiveSheet.Cells(4, Columns.Count).End(xlToLeft).Column
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If rng > 0 Then
ActiveSheet.Range("A5" & lastRow).Select
Selection.Copy
PasteSelection.Offset(1, 0).PasteSpecial xlPasteValues
'Error Object Required
End If
End Sub
Normally I wouldn't answer if the question doesn't include any code to show effort, but I started writing the below while the question actually did show code so I may as well provide it. It may achieve what you are after.
Sub shiftdown()
' shiftdown Macro
Dim rng As Range
With ActiveSheet
If .Range("A1").Value > 0 Then
Set rng = .Range(.Cells(5, 1), _
.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, _
.Cells(4, .Columns.Count).End(xlToLeft).Column))
rng.Offset(1, 0).Value = rng.Value
.Rows(5).EntireRow.ClearContents
End If
End With
End Sub
Set rng = ActiveSheet.Range("A1").Value ???
if rng is a range, then replace it by :
Set rng = ActiveSheet.Range("A1")
or if rng is a variable, replace
Dim rng As Range
by
Dim rng As variant
rng = ActiveSheet.Range("A1").Value
another error :
you declared rng as range and then you test if it is > 0
If rng > 0 Then ...
it is not possible
I have a data sheet that populates other worksheets within the file based upon an advanced filter I created. I only need to copy certain columns from the advanced filter and not the entire filter depending upon the report desired. When the advanced filter brings back nothing (meaning there are no matches for that month) the script is copying and pasting the header instead of copying and pasting nothing. Any suggestions on how to avoid copying and pasting the header when the advanced filter brings back no results? Here is the script for the first worksheet that gets copied:
Sub Populate()
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = Worksheets("Data")
sht.Range("A1:S400").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Sheets("Sheet1").Range("A1:S12"), Unique:=False
Set StartCell = sht.Range("G2")
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column
sht.Range(StartCell, sht.Cells(LastRow, "M")).Copy
Worksheets("OC 2016 - Post-65").Range("A18").PasteSpecial Paste:=xlPasteValues
Sheet3.Columns().AutoFit
Application.CutCopyMode = False
For those who may have a similar problem and want to see how I fixed my problem, I'll post what I edited thanks to Scott's answer above. I'm not an expert, so I may have misplaced the If statement but it is working in what I am doing.
Sub Populate()
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = Worksheets("Data")
sht.Range("A1:S400").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Sheets("Sheet1").Range("A1:S12"), Unique:=False
Set StartCell = sht.Range("G2")
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column
If LastRow > 2 Then
sht.Range(StartCell, sht.Cells(LastRow, "M")).Copy
Worksheets("OC 2016 - Post-65").Range("A18").PasteSpecial Paste:=xlPasteValues
End If
Sheet3.Columns().AutoFit
Application.CutCopyMode = False