I am trying to do something I imagine is really simple however I am stuck on part of the code.
I need the code to look at last row with a number in in column A and fill the series down once i.e.
A20 = 0019
A21 = 0020
Dim LastRow As Variant
Dim LastBlankRow As Variant
LastRow = Range("A" & Rows.Count).End(xlUp).Offset(0).Select
LastRow2 = Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.AutoFill Destination:=Range(LastRow & LastBlankRow), Type:=xlFillDefault
I started off with this code and developed it to the one above however my range will change each time as more data is entered.
Range("A20").Select
Selection.AutoFill Destination:=Range("A20:A21"), Type:=xlFillDefault
Range("A20:A21").Select
I imagine its something simple I have missed however I cant figure it out.
Thanks!
Don't rely on ActiveSheet, always qualify your Range, Rows objects with your Worksheet.
Code
Option Explicit
Sub FillOneDown()
Dim LastRow As Variant
With Worksheets("Sheet1") ' modify "Sheet1" to your sheet's name
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A" & LastRow).AutoFill Destination:=.Range(.Cells(LastRow, "A"), .Cells(LastRow + 1, "A")), Type:=xlFillDefault
End With
End Sub
Related
I am trying to copy data from multiple tabs to one single tab. The data need to be filtered first then copied from different tabs to a new tab. Data from different tabs (has random number of lines)should be continuous within the new tab. Due to the size of the data, it is divided into multiple tabs. So merging tabs into one tab first is not an option.
I have below difficulties that need help:
From second tab, I don’t need to copy the header of data. Any command can be added to the code?
Current codes not copying all four tabs, I am not too sure what is the issue
Can my active sheet be a general command instead of specific like ActiveSheet.Range("$A$1:$U$493692")?
See below code
Sub Filter_FSI()
'
' Filter_FSI Macro
'
'
Dim lastRow As String
lastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("Train 3-8").Select
ActiveSheet.Range("$A$1:$U$493692").AutoFilter Field:=4, Criteria1:="FSI"
ActiveSheet.AutoFilter.Range.Copy
Sheets("Sheet1").Select
Range("A1").Select
Sheets("Sheet1").Paste
Sheets("Train 9-14").Select
ActiveSheet.Range("$A$1:$U$539243").AutoFilter Field:=4, Criteria1:="FSI"
ActiveSheet.AutoFilter.Range.Copy
Sheets("Sheet1").Select
Range("A" & lastRow).Select
ActiveSheet.Paste
Sheets("Train 15-25").Select
ActiveSheet.Range("$A$1:$U$528028").AutoFilter Field:=4, Criteria1:="FSI"
ActiveSheet.AutoFilter.Range.Copy
Sheets("Sheet1").Select
Range("A" & lastRow).Select
ActiveSheet.Paste
Sheets("Train 27-41").Select
ActiveSheet.Range("$A$1:$U$298055").AutoFilter Field:=4, Criteria1:="FSI"
ActiveSheet.AutoFilter.Range.Copy
Sheets("Sheet1").Select
Range("A" & lastRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Copy
Windows("Train Data JULY_Sam Edit.xlsb").Activate
End Sub
So a couple things I noticed with your code - you're declaring lastrow as a string, but that should really be a long since it's representing a number.
Personally, I'm not a fan of autofiltering - and like Peh said above, you want to avoid using Select and Copy/Paste when you can. Try this solution below - it's my personal preference of doing things. We loop through all your worksheets, then loop through every cell in Column D - if it is equal to "FSI", we bring it to Sheet1:
Option Explicit
Sub Filter_FSI()
Dim sht As Worksheet, sht2 As Worksheet
Dim lastrow As Long, i As Long, j As Long, k As Long
Dim myworksheets As Variant
Set sht = ThisWorkbook.Worksheets("Sheet1")
myworksheets = Array("Train 3-8", "Train 9-14", "Train 15-25", "Train 27-41")
'Bring in headers
sht.Range("A1:U1").Value = Worksheets("Train 3-8").Range("A1:U1").Value
k = 2
For i = 0 To UBound(myworksheets)
Set sht2 = Worksheets(myworksheets(i))
lastrow = sht2.Cells(sht2.Rows.Count, 4).End(xlUp).Row
For j = 2 To lastrow
If sht2.Cells(j, 4).Value = "FSI" Then
sht.Range("A" & k & ":U" & k).Value = sht2.Range("A" & j & ":U" & j).Value
k = k + 1
End If
Next j
Next i
End Sub
I'm trying to autofill this formula from AD2 down to the end of the dataset. But, instead, my macro will use the formula on AD1 (the column title) and not fill down. I've done this several times, but I can't figure out why it's acting up now. The obnoxious formula is reading the from the cell a few columns over (AB) and then declares one of three strings.
Dim lastRow As Long
lastRow = Cells(Rows.Count).End(xlUp).Row
Range("AD2").Select
Selection.FormulaR1C1 = _
"=IF(NOT(ISERROR(FIND(""iMac"",RC[-2]))),""iMac"",IF(NOT(ISERROR(FIND(""MacBook"",R[-21]C[-2]))),""MacBook"",""N/A""))"
Range("AD2").Select
Selection.AutoFill Destination:=Range("AD2:AD" & lastRow)
try to modify your var lastRow with ActiveSheet.Cells(ActiveSheet.Rows.Count, "AB").End(xlUp).Row
Sub test()
Dim lastRow As Long
lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "AB").End(xlUp).Row
Range("AD2").Select
Selection.FormulaR1C1 = _
"=IF(NOT(ISERROR(FIND(""iMac"",RC[-2]))),""iMac"",IF(NOT(ISERROR(FIND(""MacBook"",R[-21]C[-2]))),""MacBook"",""N/A""))"
Range("AD2").Select
Selection.AutoFill Destination:=Range("AD2:AD" & lastRow)
End Sub
Try this. You are missing a column in your Cells (I have used column A so change to suit) and you don't need to select anything. In fact you probably don't need Autofill at all, just apply to the whole range in one go.
Sub y()
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Range("AD2")
.FormulaR1C1 = _
"=IF(NOT(ISERROR(FIND(""iMac"",RC[-2]))),""iMac"",IF(NOT(ISERROR(FIND(""MacBook"",R[-21]C[-2]))),""MacBook"",""N/A""))"
.AutoFill Destination:=Range("AD2:AD" & lastRow)
End With
End Sub
I'm running into an issue where I'm unable to copy only visible cells to a new sheet. I'm able to get the lastrow, but I get #N/A on every cell except the first for each column. I want to just copy the visible cells. I'd also like to only put information on visible rows too, if possible?
Please see my code below:
Sub Importe()
lastRow = Worksheets("Sheet1").Cells(1, 1).SpecialCells(xlCellTypeVisible).End(xlDown).Row
Worksheets.Add
With ActiveSheet
Range("A1:A" & lastRow).Value2 = _
ActiveWorkbook.Worksheets("Sheet1").Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible).Value
Range("B1:B" & lastRow).Value2 = _
ActiveWorkbook.Worksheets("Sheet1").Range("E1:E" & lastRow).SpecialCells(xlCellTypeVisible).Value
End With
End Sub
Something like .Value2 = .Value doesn't work on special cells of type visible, because …
… e.g. if lastRow = 50 and there are hiddenRows = 10 then …
your source Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible)
has lastRow - hiddenRows = 40 rows
but your destination Range("A1:A" & lastRow).Value2
has lastRow = 50 rows.
On the first you subtract the visible rows, so they are different in size. Therefore .Value2 = .Value doesn't work, because you cannot fill 50 rows with only 40 source rows.
But what you can do is Copy and SpecialPaste
Option Explicit
Sub Importe()
Dim lastRow As Long
lastRow = Worksheets("Sheet1").Cells(1, 1).SpecialCells(xlCellTypeVisible).End(xlDown).Row
Worksheets.Add
With ActiveSheet
ActiveWorkbook.Worksheets("Sheet1").Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible).Copy
.Range("A1").PasteSpecial xlPasteValues
ActiveWorkbook.Worksheets("Sheet1").Range("E1:E" & lastRow).SpecialCells(xlCellTypeVisible).Copy
.Range("B1").PasteSpecial xlPasteValues
End With
End Sub
Nevertheless I recommend to avoid ActiveSheet or ActiveWorkbook if this is possible and reference a workbook eg by ThisWorkbook. My suggestion:
Option Explicit
Sub Importe()
Dim SourceWs As Worksheet
Set SourceWs = ThisWorkbook.Worksheets("Sheet1")
Dim DestinationWs As Worksheet
Set DestinationWs = ThisWorkbook.Worksheets.Add
Dim lastRow As Long
lastRow = SourceWs.Cells(1, 1).SpecialCells(xlCellTypeVisible).End(xlDown).Row
SourceWs.Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible).Copy
DestinationWs.Range("A1").PasteSpecial xlPasteValues
SourceWs.Range("E1:E" & lastRow).SpecialCells(xlCellTypeVisible).Copy
DestinationWs.Range("B1").PasteSpecial xlPasteValues
End Sub
To define whether a cell is visible or not, both its column and row should be visible. This means, that the .Hidden property of the column and the row should be set to False.
Here is some sample code of how to copy only the visible ranges between two worksheets.
Imagine that you have an input like this in Worksheets(1):
Then you manually hide column B and you want to get in Worksheets(2) every cell from the Range(A1:C4), without the ones in column B. Like this:
To do this, you should check each cell in the range, whether its column or row is visible or not.
A possible solution is this one:
Sub TestMe()
Dim myCell As Range
For Each myCell In Worksheets(1).Range("A1:C4")
If (Not Rows(myCell.Row).Hidden) And (Not Columns(myCell.Column).Hidden) Then
Dim newCell As Range
Set newCell = Worksheets(2).Cells(myCell.Row, myCell.Column)
newCell.Value2 = myCell.Value2
End If
Next myCell
End Sub
Just a general advise - whenever you use something like this Range("A1").Value2 = Range("A1").Value2 make sure that both are the same and not the left is Value2 and the right is .Value. It probably will not bring what you are expecting.
You cannot perform a direct value transfer without cycling though the areas of the SpecialCells(xlCellTypeVisible) collection.
Sometimes it is easier to copy everything and get rid of what you don't want.
Sub Importe()
Dim lr As Long
Worksheets("Sheet1").Copy after:=Worksheets("Sheet1")
With ActiveSheet
.Name = "xyz"
.Cells(1, 1).CurrentRegion = .Cells(1, 1).CurrentRegion.Value2
For lr = .Cells(.Rows.Count, "A").End(xlUp).Row To 1 Step -1
If .Cells(lr, "A").EntireRow.Hidden Then
.Cells(lr, "A").EntireRow.Delete
End If
Next lr
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(1, 1).CurrentRegion.Resize(lr, 1) = .Cells(1, 1).CurrentRegion.Resize(lr, 1).Offset(0, 7).Value2
.Cells(1, 1).CurrentRegion.Offset(0, 1).Resize(lr, 1) = .Cells(1, 1).CurrentRegion.Resize(lr, 1).Offset(0, 4).Value2
.Columns("C:XFD").EntireColumn.Delete
End With
End Sub
just to throw in an alternative version:
Sub Importe()
Dim sht1Rng As Range, sht1VisibleRng As Range
With Worksheets("Sheet1")
Set sht1Rng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
End With
Set sht1VisibleRng = sht1Rng.SpecialCells(xlCellTypeVisible)
With Worksheets.Add
.Range("A1").Resize(sht1Rng.Rows.Count).Value2 = sht1Rng.Offset(, 7).Value2
.Range("B1").Resize(sht1Rng.Rows.Count).Value2 = sht1Rng.Offset(, 4).Value2
.UsedRange.EntireRow.Hidden = True
.Range(sht1VisibleRng.Address(False, False)).EntireRow.Hidden = False
End With
End Sub
which may have the drawback of Address() maximum "capacity "
I am working on my code and I have this to filter rows and insert a formula in the first filter row. with that formula I want it to fill down, but it only insert the formula in the first filtered row and doesn't fill down.
Sub Cal()
dim LastRow as long
With Worksheets("Data")
.Range("$A$1:$AI$80000").AutoFilter Field:=1, Criteria1:= _
"Actual"
.Range("$A$1:$AI$80000").AutoFilter Field:=2, Criteria1:="2018"
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.AutoFilter.Range.Offset(2).SpecialCells(xlCellTypeVisible).Cells(1, 35).Select 'SELECTS THE FIRST cell in A after deleting
ActiveCell.FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
.AutoFilter.Range.Offset(2).SpecialCells(xlCellTypeVisible).Cells(1, 35).Select
Selection.FillDown
End With
End Sub
How about something like below, instead of .FillDown, specify the range for the last column of visible data, and offset to the next column to enter the formula in there:
Sub Cal()
Dim LastRow As Long
With Worksheets("Data")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("$A$1:$AI$" & LastRow).AutoFilter Field:=1, Criteria1:="Actual"
.Range("$A$1:$AI$" & LastRow).AutoFilter Field:=2, Criteria1:="2018"
'filter according to values specified
Set fltrdrng = .Range("$AI$2:$AI$" & LastRow).SpecialCells(xlCellTypeVisible)
'set the range of visible data on last column with data on your data-set
fltrdrng.Offset(0, 1).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
'add the formula to the adjacent column by offsetting
End With
End Sub
This should do what you want. Autofilling is very dangerous with filtered data. This gets the activecell address and then creates the last cell address(row 80000 from your code), and then adds the formula to every cell in the range that is visible.
Start = ActiveCell.address
arow = ActiveCell.Row
alen = Len(arow)
lcell = Left(Start, Len(Start) - alen) & "80000"
Range(Start & ":" & lcell).SpecialCells(xlCellTypeVisible).Formula = "=SUM(RC[-12]:RC[-1])"
I need to cut cells from H2:L2 to all the way down and paste it in last row of column B.
Data will be different everytime so I cannot hard code any range.
VBA code would be nice, to cut from H2:L2 down and paste/insert in the last row of Column B.
So far I got.
Range("H2:L2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Here is a segment of code that should accomplish what you are looking for.
Start code including your cut segment...
Dim lastRow As String
lastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
Range("B" & lastRow).Select
Selection.PasteSpecial
Rest of code...
There are a number of books that will help with this type of coding and have step by step trainig. I am partial to the series published by Microsoft "Step by Step" series. Best of luck!
please see below (ps. I have not tested it)
Sub copypaste()
Dim wb As Workbook, ws As Worksheet, rng As Range, lr As Long
Set wb = Workbooks("Name_of_your_workbook.xlsm")
Set ws = wb.Sheets("Your_Sheet_Name")
Set rng = ws.Range("H2:L2")
lr = Sheet("Your_Sheet_Name").Cells(Rows.Count, "B").End(xlUp).Row
rng.Copy Destination:=ws.Range("B" & lr)
Cells(1, 1).Select
End Sub