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
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 am new to VBA and normally source VBA codes from online to automate manual works. I am looking for VBA code for vlookup. I have recorded a macro with column contains 356 line of records, but when I run the macro next time with less number of rows. It still look up for 356. How do I lookup only for the cells which has values in reference cell. Please advice
Well, since you didn't post your code here, all I can do is guess what you are trying to do. You probably need to find the last used row before implementing your vlookup methodology. Something like this should help.
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
Sub Macro1()
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ActiveSheet
LastRow = sht.Cells(sht.Rows.Count, "E").End(xlUp).Row
Range("F1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],C[-5]:C[-4],2,FALSE)"
Range("F1").Select
Selection.AutoFill Destination:=Range("F1:F" & LastRow)
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 need to copy values of one excel and create a new one with required format. Say i need to copy columns from B11 to BG11 and rows will be till the end.( i don't know how to find the end of rows). And I have column heading in b7 to bg7. In between there are unwanted rows and i don't need it. So in the new excel i want column headings(which is from b7 to bg7) as first row and the values from b11 to bg11 till the end.
This is my first excel Macro. I don't know how to proceed. So with references from some stackoverflow question and other site, i have tried the below code. but it is not giving the required output.
Sub newFormat()
Dim LastRow As Integer, i As Integer, erow As Integer
LastRow = ActiveSheet.Range(“B” & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
Sheets("MySheetName").Range("B7:BG7").Copy
Sheets("MySheetName").Range("B11:BG11").Copy
Workbooks.Open Filename:=”C:\Users\abcd\Documents\Newformat.xlsx”
Worksheets(“Sheet1”).Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If
Next i
End Sub
this may be simple. any help would be appreciated.
Few things...
Do not use Integer for rows. Post xl2007, the number of rows have increased and Integer can't hold that. Use Long
You do not need to select a range to paste on it. You can directly perform the action.
You do not need to use a loop. You can copy ranges in two chunks
Work with objects so Excel doesn't get confused by your objects.
Since Sheet1 is empty, you don't need to find the last row there. Simply start at 1.
To output the data to new workbook, you have to use Workbooks.Add
See this example (Untested)
Sub newFormat()
Dim wbO As Workbook
Dim wsI As Worksheet, wsO As Worksheet
Dim LastRow As Long, erow As Long
'~~> Set this to the relevant worksheet
Set wsI = ThisWorkbook.Sheets("HW SI Upload")
'~~> Find the last row in Col B
LastRow = wsI.Range("B" & wsI.Rows.Count).End(xlUp).Row
'~~> Open a new workbook
Set wbO = Workbooks.Add
'~~> Set this to the relevant worksheet
Set wsO = wbO.Sheets(1)
'~~> The first row in Col A for writing
erow = 1
'~~> Copy Header
wsI.Range("B7:BG7").Copy wsO.Range("A" & erow)
'~~> Increment output row by 1
erow = erow + 1
'~~> Copy all rows from 11 to last row
wsI.Range("B11:BG" & LastRow).Copy wsO.Range("A" & erow)
'~~> Clear Clipboard
Application.CutCopyMode = False
'
'~~> Code here to do a Save As
'
End Sub
Different but the same
Rename the sheet
Sub Button1_Click()
Dim wb As Workbook, ws As Worksheet, sh As Worksheet
Dim LstRw As Long, Rng As Range, Hrng As Range
Set sh = Sheets("MySheetName")
With sh
Set Hrng = .Range("B7:BG7")
LstRw = .Cells(.Rows.Count, "B").End(xlUp).Row
Set Rng = .Range("B11:BG" & LstRw)
End With
Application.ScreenUpdating = 0
Workbooks.Open Filename:="C:\Users\abcd\Documents\Newformat.xlsx"
Set wb = Workbooks("Newformat.xlsx")
Set ws = wb.Sheets(1)
Hrng.Copy ws.Cells(Rows.Count, "A").End(xlUp).Offset(1)
Rng.Copy ws.Cells(Rows.Count, "A").End(xlUp).Offset(1)
ws.Name = sh.Name 'renames sheet
wb.Save
wb.Close
End Sub