I would like to copy a range from a filtered table to another sheet. The starting point is easy however I would like to only copy a number of rows down based on a cell that a user enters into. I can make it work when I hard code the number however I would like to make this based on a cell.
The variable lastrow is where I need to have the cell H4. (H4 in my spreadsheet is where the user keys in the number of rows to copy)
My code thus far is:
Sub Line()
Dim Copyrange As String
Dim lastrow As Range
Startrow = 8
lastrow = 10
Let Copyrange = "B" & Startrow & ":" & "H" & lastrow
Range(Copyrange).Select
End Sub
Any help is really appreciated
Sounds like all you need is this?
Let Copyrange = "B" & Startrow & ":" & "H" & Range("H4")
Changing my answer to the following instead. Not the best of solutions, as working with SpecialCells is tricky at best, but this might suit your needs fairly well.
Sub Illusion()
Dim Source, Dummy As Worksheet
Dim SRow, LRow As Long
Application.ScreenUpdating = False
With ThisWorkbook
Set Source = .ActiveSheet
Set Dummy = .Sheets.Add(After:=Sheets(Sheets.Count))
End With
SRow = 8
LRow = Range("H4").Value + 1
'Change the H10000 below to the correct end row of your unfiltered table.
Source.Range("B" & SRow & ":H10000").SpecialCells(xlCellTypeVisible).Copy
With Dummy
'We create an illusion that we copy only the names we need by bridging using a dummy sheet and copying from there.
.Range("A1").PasteSpecial xlPasteValues
.Range("A1:A" & LRow).Copy
'Paste to desired location as values as well.
.Delete
End With
Application.ScreenUpdating = True
End Sub
What I did here was, we copy the visible cells into a dummy sheet, adjust the number of names to copy from that dummy sheet and do whatever you want with it, then delete the dummy sheet. It's a quick and dirty, but it beats having to go to the intricacies of SpecialCells.
Related
I am trying to write a program, where I must first apply the filter to Column S with 6 possible filter values (1,2,3,4,5,6). Once the filter is applied, I must copy the last used cell in column T and paste the same in the next available (blank) visible cell in column V with the filter still being on.
Once it pastes the values successfully,if I were to apply filter again for the same value, it should repeat the same by finding the next available visible blank cell column V and paste the copied data.
The loop should keep working, For the next instance, based on the condition I might apply the filter for value 2 in the column, I must copy the last used column T data and paste in the next available visible cell in column V with the filter still being on.
I tried many possibilities like End(xlUp) it works only until copying the value from Column T and I am unable to paste it in Column V.I tried using Application.SendKeys method too. It doesn't work all the time.
The following codes that I have pasted down below, I tried copying the value of the last used cell in Column T with End(xlup), which worked all the time, the problem is all about the finding the right next available visible cell in column V to paste the same, sometime it works and sometimes it pastes in the hidden rows
enter image description here
Sub auto_filter2()
Dim ws As Worksheet
Dim ds As Worksheet
Dim SrcLastRow As Long, DestLastRow As Long
Set ws = Worksheets("PVF")
Set ds = Worksheets("Filtered")
Worksheets("PVF").Range("T4").AutoFilter Field:=19, Criteria1:="2"
MsgBox "Its Working"
Sheets("PVF").Select
SrcLastRow = Cells(Rows.Count, "T").End(xlUp).Row
Range("T" & SrcLastRow).Select
Selection.Copy
MsgBox SrcLastRow & " is the row"
Sheets("PVF").Select
Range("V5").End(xlDown).Select
Application.SendKeys "{DOWN}"
Application.SendKeys ("^v{Enter}")
ws.AutoFilterMode = False
End Sub
Sub auto_filter()
Dim ws As Worksheet
Dim ds As Worksheet
Dim SrcLastRow As Long, DestLastRow As Long
Set ws = Worksheets("PVF")
Set ds = Worksheets("Filtered")
Worksheets("PVF").Range("T4").AutoFilter Field:=19, Criteria1:="4"
MsgBox "Its Working"
Sheets("PVF").Select
SrcLastRow = Cells(Rows.Count, "T").End(xlUp).Row
Range("T" & SrcLastRow).Select
Selection.Copy
MsgBox SrcLastRow & " is the row"
Sheets("Filtered").Select
DestLastRow = Cells(Rows.Count, "C").End(xlUp).Row
Range("C" & DestLastRow).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Dim cel As Range
With Sheets("PVF")
Set cel = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)(1, 1)
If cel = "" Then
.Cells(cel.Row, "V") = Sheets("Filtered").Range("C3")
Else
MsgBox (" Non- empty box")
End If
End With
ws.AutoFilterMode = False
End Sub
I hope to solve this problem soon. Many thanks for your solutions in advance.
Hello I want to delete empty rows of a table and i am finding issues.
Dim rng As Range
rng = Sheets("NewForecast").ListObjects("Table").Range.Select
If rng.Rows = 0 Then
rng.EntireRow.Delete
End If
I don't know how to write it, I tried several ways, looked for here, but could not find an specific solution. I want delete if the Row is completely empty. Any help much appreciated!
I managed to work on that! Thanks for all who actually opened my mind. Look below, it is simple and doing what I want, macro goes faster too.
Range("Table[#Headers]").Select
Selection.AutoFilter
ActiveSheet.ListObjects("Table").Range.AutoFilter Field:=2, Criteria1:="="
Range("Table").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
Range("Table[#Headers]").Select
ActiveSheet.ShowAllData
Try something like
Dim ws as Worksheet
Set ws = ActiveWorkbook.Worksheets("SHEET NAME HERE")
Dim lRow as long
Dim rng as range
lRow = ws.Range("A" & Rows.Count).end(xlUp).row
'Assuming your table starts in column A, put in start/end row numbers
For each rng in ws.Range("A1:A" & lRow)
If ws.Range("A" & rng.row) = vbNullString then
ws.Rows(rng.row).Delete
End if
Next rng
When trying to delete rows in a sheet, always use a backward For loop (For i = 100 to 1 Step -1 for instance).
When checking if a certain Range or Row is completely empty, the WorksheetFunction.CountA comes in quite handy.
Option Explicit
Sub DeleteEmptyRows()
Dim Rng As Range
Dim LastRow As Long
Dim lRow As Long
With Sheets("NewForecast")
Set Rng = .ListObjects("Table").Range
' find last row in "Table"
LastRow = .ListObjects("Table").Range.Rows.Count
' loop through all "Table" rows, loop backwards when deleting
For lRow = LastRow To 2 Step -1
' use CountA to check if entire row is empty
If WorksheetFunction.CountA(.Rows(lRow)) = 0 Then
.Rows(lRow).EntireRow.Delete
End If
Next
End With
End Sub
This is possible without looping.
Filter the table so the values showing are the ones you want to delete
Find the first "deletable" row (where cell.value = "") in the last column of the sheet (will most typically be blank, most people don't use the last column),
Then find the last "deletable" row (where cell.value = "").
Then use this:
Rows(firstRow & ":" & lastRow).EntireRow.Delete
This can be expensive (take a long time) if your field of values is very large but works on sheets as well as tables and is faster (better) than looping.
I would like to copy entire row from today Sheet to last available row of main Sheet if today Sheet B2:B cell value = "Update". However, I come up with copy area and paste area are not the same size issue. I've tried many ways but cannot get it solved. Can anyone help? Thanks in advanced.
Sub getnew()
Dim Sheet1 As Worksheet
Dim Sheet3 As Worksheet
Dim lastrow As Integer
Dim i As Integer
Set Sheet1 = ThisWorkbook.Sheets("main")
Set Sheet3 = ThisWorkbook.Sheets("today")
lastrow = Sheet3.Range("C" & Rows.Count).End(xlUp).Row
Dim erow As Long
For i = 2 To lastrow
erow = Sheet1.Range("C" & Rows.Count).End(xlUp).Row + 1
If Sheet3.Cells(i, 2).Value = "Update" Then
Sheet3.Cells(i, 2).EntireRow.Copy Destination:=Sheet1.Range("B" & erow)
End If
Next i
End Sub
You are trying to copy the entire row of a worksheet, but you are pasting that row in another sheet, starting at column B. They aren't the same size, because an entire row contains 16,384 columns, but a row starting at column B only has 16,383 columns.
You have a few options to resolve this:
You could paste the entire row onto the other sheet at column A, like so:
Sheet3.Cells(i, 2).EntireRow.Copy Destination:=Sheet1.Range("A" & erow)
Or you could copy only the number of columns which you care about, instead of trying to copy the entire row, like so [I don't know what it is you're trying to copy, so you will need to figure out how exactly you want to size it. I have assumed that 10 columns is sufficient]:
Sheet3.Range(Cells(i, 2), Cells(i,11)).Copy Destination:=Sheet1.Range("B" & erow)
Original issue:
I want to import a column in an other sheet and update it by adding the modified cells at the bottom.
I tried the code below but it gives an error in the third line can someone help me?
Fixed by defining lrow
lRow = Worksheets("Analyse de risque").Range("C6").End(xlDown).Row
New issue:
It just adds the same column many times at the bottom, i don't understand why?
Public Sub Refreshing()
Dim aCell As Range
If Worksheets("Analyse").Range("C6:C" & lRow).Cells.Count > 1 Then
For Each aCell In Worksheets("Analyse").Range("C6:C" & lRow).Cells
With aCell
Dim wsI As Worksheet
Dim lRowWsI As Long, lRowWsO As Long
'~~> Find the last row where the data needs to go
lRowWsO = Worksheets("PTR").Range("B" & Worksheets("PTR").Rows.Count).End(xlUp).Row + 1
'~~> Set Input Sheet
Set wsI = Worksheets("Analyse")
With wsI
'~~> Find Last Row to get the range you want to copy
lRowWsI = .Range("C" & .Rows.Count).End(xlUp).Row
'~~> Do the final Copy
.Range("C6:C" & lRowWsI).Copy Destination:=Worksheets("PTR").Range("B" & lRowWsO)
End With
End With
Next
Application.CutCopyMode = False
End If
End Sub
You do not need to loop through the cells in the Analyse sheet. You just need to do the copy and paste one time.
Get rid of:
For Each aCell In Worksheets("Analyse").Range("C6:C" & lRow).Cells
With aCell
and the End With and the Next that match the lines you got rid of.
I have four rows of information that I filter. (month, Name, Service, units) I filter the information by name and month. (depending on information needed) I have put together the following to try and grab the top row of filtered data and place it on another sheet.
Sub Mine()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim lRow As Long
Set sht1 = ThisWorkbook.Sheets("Export")
Set sht2 = ThisWorkbook.Sheets("DB1")
lRow = sht1.Cells(Rows.Count, "A").End(xlUp).Row + 1
sht1.Range("b" & lRow) = sht2.Range("A2" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible) 'Month
sht1.Range("a" & lRow) = sht2.Range("E2" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible) 'Client Name
sht1.Range("c" & lRow) = sht2.Range("C2" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible) 'Service
sht1.Range("d" & lRow) = sht2.Range("H1" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible) 'Units
End Sub
This does not error out, it just doesn't copy anything to the "export" sheet. The only way I can get anything to copy from one sheet to another is to take the specialcells out. As follows...
Sub Mine()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim lRow As Long
Set sht1 = ThisWorkbook.Sheets("Export")
Set sht2 = ThisWorkbook.Sheets("DB1")
lRow = sht1.Cells(Rows.Count, "A").End(xlUp).Row + 1
sht1.Range("b" & lRow) = sht2.Range("A2") 'Month
sht1.Range("a" & lRow) = sht2.Range("E2") 'Client Name
sht1.Range("c" & lRow) = sht2.Range("C2") 'Service
sht1.Range("d" & lRow) = sht2.Range("H1") 'Units
End Sub
But as said prior, it only copies the first line, filtered or not. My goal is to obtain the filtered top line of "DB1" and copy it to sequenced cells in "Export". Any assistance would be greatly appreciated.
-JGr3g
Okay, so I don't think your code is doing what you think it is.
Lets take some apart
sht2.Range("A2" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible)
You're calling sht2.Range() and passing it a string. That string is the concatenation of "A2" and Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible).
What is Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible)? Well implicitely Cells is a range representing every cell in the active spreadsheet, ThisWorkbook.ActiveSheet.Cells. Then you're asking for SpecialCells(xlCellTypeLastCell) and taking it's row? What happened to sht1 and sht2? You aren't using them, you're using the active sheet?
So if the last cell of the active sheet is in row 50, you are asking for "A2" & 50 which would get "A250", which would be blank since the last used row is 50...
First things first, I'd recommend you avoid using string concatenation for finding cells. None of this "A" & numericVariable stuff. Use something more direct like Cells(numericVariable, 1). Excessive string manipulation will likely hurt you. The cells property can take a row and a column as parameters.
Is your filered range a table/listobject or just a plain old range with an AutoFilter on it? If it's a listobject, get the listobject, get it's DataBodyRange, use .SpecialCells(xlCellTypeVisible) on that, THEN get the first row of the resulting range.
Similarly if it's an autofiltered range, get the target data range, the entire data range. Once you have that, grab the visible cells, then get the first row.
Edit: Untested example
set targetRow = ws.Range(ws.Cells(2, 1), ws.Cells(lRow, 5)).SpecialCells(xlCellTypeVisible).Row(1)
targetSheet.Range("A2") = targetRow.Cells(1,2)
Okay, so what's this doing? I'm taking a worksheet variable ws and getting a range on it. .Range(ws.Cells(2, 1), ws.Cells(lRow, 5)). That range, is from the second row, first column, aka "A2". It goes to the row number contained in lRow on the 5th column, aka "E" & lRow.
From there it gets only the visible cells .SpecialCells(xlCellTypeVisible) then gets the first row of the first area in the selection .Row(1)
Once we have that first row, we can get different columns from it with either .Cells or .Column.