Autofill won't start at desired cell and won't fill down - vba

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

Related

Only copy visible range in VBA?

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 "

Auto fill not working

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])"

VBA Code to Fill Series down to the next blank cell once

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

reference issue using vba

I have 3 columns, with headers A B & C as shown at the picture, and I want to check if the value in column A is equal to 10% of column B, if yes, I want to set it to be the value for column C, if not, I want to get 10% of values in column B. I am in sheet1 and I want to set a VBA button in sheet2 to run the codes.
Here is the code:
Sub Macro1()
Dim ws As Worksheet, lastrow As Long
Set ws = Worksheets("sheet1")
ws.Activate
ActiveCell.Formula = "=IF(A2=B2*0.1, A2, B2*0.1)"
lastrow = Range("A" & Rows.Count).End(xlUp).Row
Range("C2").AutoFill Destination:=Range("C2:C" & lastrow), Type:=xlFillDefault
End Sub
My issues is if I point my mouse at C2 in sheet1 and I just run the vba codes, it will work. If I am at sheet2 and pressing the button, it won't work, it just doesn't show any data. Is there a way to set values to column C based on my criteria?
To make the code working on sheet1 independently of active sheet is, you need to apply .Range method exactly to Worksheets("sheet1") object. Try the below code:
Sub Macro1()
Dim lastrow As Long
With Worksheets("sheet1")
lastrow = .Range("A" & Rows.Count).End(xlUp).Row
If lastrow = 1 Then
MsgBox "No data"
Exit Sub
End If
.Range("C2:C" & lastrow).Formula = "=IF(A2=B2*0.1, A2, B2*0.1)"
End With
End Sub
Why not to be more straightforward: always set the value to column C equal to 10% of column B? The result will be the same.
Sub Macro1()
Dim lastrow As Long
With Worksheets("sheet1")
lastrow = .Range("A" & Rows.Count).End(xlUp).Row
If lastrow = 1 Then
MsgBox "No data"
Exit Sub
End If
.Range("C2:C" & lastrow).Formula = "=B2*0.1"
End With
End Sub

Apply formula to a range of cells

I have some code which I know works, I am applying a SUMIF formula to a range of cells. It works but it add a load of extra row at the bottom that shouldn't be there. I tried adding in a do until loop but it gets stuck in an infinite loop and crashes.
This is my first lot of code which works but adds the extra row in only on the columns which have been copied over.
Dim z As Workbook 'Budget Workbook
Dim y As Workbook 'Formatted - current workbook
Dim lastRow As Integer
Dim budgLastRow As Integer
Dim rng As Range
Set y = Workbooks("DLT.xlsm")
Set z = Workbooks.Open("C:\Reports\Budget.xlsx")
'Apply function to columns to pull costing data
With y.Worksheets("DLT")
lastRow = Cells(Rows.Count, 5).End(xlUp).Row
For Each rng In .Range("AI22:AI" & lastRow)
rng.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$E" & rng.Row & ",'[Budget.xlsx]DynamicReport'!H:H)"
rng.Value = rng.Value
Next rng
For Each rng In .Range("AJ22:AJ" & lastRow)
rng.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$E" & rng.Row & ",'[Budget.xlsx]DynamicReport'!I:I)"
rng.Value = rng.Value
Next rng
For Each rng In .Range("AN22:AN" & lastRow)
rng.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$E" & rng.Row & ",'[Budget.xlsx]DynamicReport'!E:E)"
rng.Value = rng.Value
Next rng
For Each rng In .Range("AO22:AO" & lastRow)
rng.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$E" & rng.Row & ",'[Budget.xlsx]DynamicReport'!G:G)"
rng.Value = rng.Value
Next rng
End With
I think the other additional rows have been copied because the budget workbook contains more data then the formatted work book. I have know thought to possibly delete the other unnecessary row which have been copied cross.
So I have added this small piece of code in
With y.Worksheets("Formatted")
lastRow = Cells(Rows.Count, 5).End(xlUp).Row - 1
budgLastRow = Cells(Rows.Count, 35).End(xlUp).Row
Rows("AI" & lastRow & ":AO" & budgLastRow).EntireRow.Delete
End With
I get an application-defined error Object defined error on the line
Rows("AI" & lastRow & ":AO" & budgLastRow).EntireRow.Delete
This is probably not the most efficient way to do this, but its the only way I could think of. I am fairly new to VBA only been coding a couple of months so mostly just try out different ways and see what works. Can anyone help me please.
You didn't properly qualify the ranges for the lastRow variable:
lastRow = .Cells(.Rows.Count, 5).End(xlUp).Row
Note the dots before Cells and Rows.
A couple of additional points:
Always use Long rather than Integer for row variables as there are more rows in a sheet than an Integer can hold.
You don't need to loop to put the same formula in a column of cells.
Dim z As Workbook 'Budget Workbook
Dim y As Workbook 'Formatted - current workbook
Dim lastRow As Long
Dim budgLastRow As Long
Set y = Workbooks("DLT.xlsm")
Set z = Workbooks.Open("C:\Reports\Budget.xlsx")
'Apply function to columns to pull costing data
With y.Worksheets("DLT")
lastRow = .Cells(.Rows.Count, 5).End(xlUp).Row
With .Range("AI22:AJ" & lastRow)
.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$E22,'[Budget.xlsx]DynamicReport'!H:H)"
.Value2 = .Value2
End With
With .Range("AN22:AN" & lastRow)
.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$E22,'[Budget.xlsx]DynamicReport'!E:E)"
.Value2 = .Value2
End With
With .Range("AO22:AO" & lastRow)
.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$E22,'[Budget.xlsx]DynamicReport'!G:G)"
.Value2 = .Value2
End With
End With