VBA Macro to Autofill a cell - vba

I am trying to find a simple autofill solution to copy the formula in cell C3 into C2 after a new line has been inserted. Here is what I have that I thought would work:
Sub AutoFill()
Set SourceRange = Worksheets("Sheet 1").Range("C3")
Set fillRange = Worksheets("Sheet 1").Range("C2")
SourceRange.AutoFill Destination:=fillRange
End Sub
Basically, in C3 (and every cell in column C after row 3) has a average function that takes the previous 20 days and creates an average. I am trying to get the macro to input that formula everytime a new row gets put in (I have the code to input the new row it just won't apply the function after the new row comes in)

The cells to be filled. The destination must include the source range.
As quoted from MSDN.
So try:
Set SourceRange = Worksheets("Sheet 1").Range("C3")
Set fillRange = Worksheets("Sheet 1").Range("C2")
SourceRange.AutoFill Destination:=Range(fillRange, SourceRange)
Another note is to use Named ranges if you are inserting rows in between.

Other ways to get formulas with updated cell references
Option Explicit
Public Sub getFormula()
With Sheet1
.Range("C3").Copy
.Range("C2").PasteSpecial xlPasteFormulas
If .ListObjects.Count = 1 Then
With .ListObjects(1) 'for tables
.Cells(2, 3).Formula = .Cells(3, 3).Formula
End With
End If
End With
End Sub
.
Also, you should not use the name of VBA method as a sub name (AutoFill)
A fast way to determine VBA keywords: click on the sub name and press F1
If the help page shows Keyword Not Found your sub name should be Ok

Related

how to use a cell value in an active column in a named row range in VBA

In a worksheet, there are two named ranges, each of which only contains a row, e.g. Range1 = Range("B5:H5") and Range2 = Range("B9:H9"). My question is: how can I reference a cell in Range1, say C5, and a cell in Range2, say C9 in VBA so that I can do something with the values in these two cells? The VBA should only run for the active column. Thank you in advance.
Maybe you should see this link.
How to avoid using Select in Excel VBA macros
As Siddarth stated,
Two Main reasons why .Select/.Activate/Selection/Activecell/Activesheet/Activeworkbook etc... should be avoided
It slows down your code.
It is usually the main cause of runtime errors.
How do we avoid it?
1) Directly work with the relevant objects
Consider this code
Sheets("Sheet1").Activate
Range("A1").Select
Selection.Value = "Blah"
Selection.NumberFormat = "#"
This code can also be written as
With Sheets("Sheet1").Range("A1")
.Value = "Blah"
.NumberFormat = "#"
End With
2) If required declare your variables. The same code above can be written as
Dim ws as worksheet
Set ws = Sheets("Sheet1")
With ws.Range("A1")
.Value = "Blah"
.NumberFormat = "#"
End With
Use can
Range1.offset()
method to refer adjacent cell
You can refer here for detail .
Would this work?
Range("Range1").Cells(1, 1).Select 'Selects Range("B5") - first cell in Range1
Range("Range1").Cells(1, "A").Select 'Also selects first cell in the named range
'copies cell 2 (C9) from Range2 into cell 2 (C5) of Range1; .Cells(row, col)
Range("Range1").Cells(1, 2) = Range("Range2").Cells(1, 2)
By using the Cells method, you can specify the appropriate row using Range1.Row (and Range2.Row), and the appropriate column using (if I understand you correctly) Selection.Column.
So perhaps something like:
Dim Range1 As Range
Dim Range2 As Range
Set Range1 = Range("B5:H5")
Set Range2 = Range("B9:H9")
'Display the value in row 5 for the current column
MsgBox Cells(Range1.Row, Selection.Column).Value
'Display the value in row 9 for the current column
MsgBox Cells(Range2.Row, Selection.Column).Value
'Change row 9 to be the value from row 5
Cells(Range2.Row, Selection.Column).Value = Cells(Range1.Row, Selection.Column).Value
'Display the updated value in row 9 for the current column
MsgBox Cells(Range2.Row, Selection.Column).Value

Excel vba Autofill only empty cells

I have a column A with data up to A300.
In this range, some of theses cells are empty, some contain values.
In VBA, I set the formula of the cell A1 then I use the autofill function to set it all over my column (up to A300) like this :
ws.Range("A1").Select
Selection.AutoFill Destination:=ws.Range(ws.Cells(1, 1), ws.Cells(300, 1))
My problem is that datas contain on some cells are erased too ! I'm trying to autofill like it but only throught the empties cells.
I tried to add a filter on my worksheet like this :
ws.Range("$A$1:$A$300").AutoFilter Field:=1, Criteria1:="="
Then I reused the autofill function, but it seems to fill thourght the filtered cells...
Can't we add a parameter like "only empties cells" to the autofill function ? Something like this :
Selection.AutoFill Destination:=ws.Range(ws.Cells(1, 1), ws.Cells(300, 1)), Criteria1:="="
Thanks for your replies !
with data like:
I would do a single copy rather than a fill-down:
Sub luxation()
Range("A1").Formula = "=ROW()"
Dim rDest As Range
Set rDest = Intersect(ActiveSheet.UsedRange, Range("A1:A300").Cells.SpecialCells(xlCellTypeBlanks))
Range("A1").Copy rDest
End Sub
with this result:
NOTE:
The formulas adjust after being copied.
EDIT#1:
Please note that there are some circumstances under which this code will not work. It is possible that UsedRange my not extend down to cell A300.
For example, if the worksheet is totally empty except for a formula in A1 and some value in A3. In this case Rdest will only include the single cell A2. The code will leave A4 through A300 untouched.
Assuming you want static values, I would use a loop. The one below will fill all empty cells with poop:
Sub AllFillerNoKiller()
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
For Each c In ws.Range("A1:A300")
If c.Value = "" Then c.Value = "poop"
Next
End Sub
Apologies, I miss-understood you question - Want to fill all blank cells with the value in A1? - here you go:
Sub Replace()
If Trim(Range("A1").Value) = "" Then
MsgBox "There's no value in A1 to copy so there's nothing to copy to all blank cells", vbInformation, "Nothing in A1"
Exit Sub
Else
Range("A1:A300").SpecialCells(xlCellTypeBlanks).Select
Selection.Value = Range("A1").Value
End If
End Sub
You can also use below code:
stAddress = Sheet1.Range("A1").CurrentRegion.SpecialCells(xlCellTypeBlanks).Address
Sheet1.Range(st).Value = "Empty"

Auto filling formula VBA

Looking for some help with a VBA function
I have data on two sheets I need to perform an index match on.
The data size will vary every time the compare is run.
I have coded the VBA to call the data and populate both sheets but running the comparison is causing a problem.
I have created the below function, its running without error but not populating the formula in cell starting J2 to end of the J range.
Sub FormulaFill()
Dim strFormulas(1 To 1) As Variant
With ThisWorkbook.Sheets("Export Worksheet")
strFormulas(1) = "=INDEX('sheet1'!E:E,MATCH('Export Worksheet'!A2,'sheet1'!A:A,0))"
.Range("J:J").FillDown
End With
End Sub
Any help would be greatly appreciated.
W
Image after updated code applied
You were writing the formula to an array variable, not a cell, then you tried to fill the entire column by using J:J. This means it was trying to fill the entire column with the contents of cell J1, the top cell, not J2.
Here is the code with corrections.
Sub FormulaFill()
With ThisWorkbook.Sheets("Export Worksheet")
.Cells(2, 10).Formula = "=INDEX('sheet1'!E:E,MATCH('Export Worksheet'!A2,'sheet1'!A:A,0))"
.Range(.Cells(2, 10), .Cells(.Cells(.Rows.Count, 9).End(xlUp).Row, 10)).FillDown
End With
End Sub
The .Cells(.Rows.Count, 9).End(XlUp).Row determines the last filled row of column 9 (I) and the code uses that number in the range to use for the autofill of column 10 (J)
It's because you're not filling the cell with the formula.
Sub FormulaFill()
Dim strFormulas(1 To 1) As Variant
With ThisWorkbook.Sheets("Export Worksheet")
strFormulas(1) = "=INDEX('sheet1'!E:E,MATCH('Export Worksheet'!A2,'sheet1'!A:A,0))"
.Range("J1").Forumla = strFormulas(1)
.Range("J:J").FillDown
End With
End Sub

Deleting duplicates in excel using VBA

i'm fairly new to VBA and could do with a bit of help. I've looked online and i've found a few bits of code but have been unable to amend to my needs.
I'm trying to create a macro that will enable me to see if their are any duplicate text between column A and B and if the text in column A matches Column B then we will need to delete the entire row. The columns are on the same sheet
I am trying to create a loop that will do this. I must also point out that the length of the list does increase every week
I would appreciate any help
Thank you
Hi try in your code VBA:
Sub DeleteRowWithContents()
'========================================================================
' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "Record Only" IN COLUMN D
'========================================================================
Last = Cells(Rows.Count, "D").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "D").Value) = "Record Only" Then
'Cells(i, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENTS BUT NOT DELETE ROW
Cells(i, "A").EntireRow.Delete
End If
Next i
End Sub
you can update this code for your problem!
I use this when i need deletes all rows from a2 downwards with the words "record only" in column d.
Maybe try this:
Sub DeleteRowWithContents()
Dim ColumnAValue As String
Dim ColumnBValue As String
Dim xlWB As Worksheet
Set xlWB = ActiveWorkbook.ActiveSheet 'If it isn't the active sheet use second row:
'Set xlWB = ActiveWorkbook.Sheets("NameOfSheet") 'Change to the name of your sheet
For i = 1 To EOF 'This goes through the whole document to the last row automatically, EOF means "End Of File"
ColumnAValue = xlWB.Cells(i, 1).Value 'row i, column "a"
ColumnBValue = xlWB.Cells(i, 2).Value 'row i, column "b"
If (ColumnAValue = ColumnBValue) Then
xlWB.Range(ColumnAValue).Select
Selection.EntireRow.Delete 'NOTE!!
End If
Next i
End Sub
NOTE: I'm not too sure if this works, can't test it right now. IF it doesn't, try this instead:
EntireRow.Select
Selection.Delete

update cell and paste it to another cell vba

I am quite new in excel vba and I would really appreciate if you can assist me.
The thing is that I have cell which updates each minute because it is linked with a function to Blomberg. The thing is that I want that each time cell updates excel copies it and pastes to another, new cell that i can observe the intra day changes.
I have come up with some codes but I can copy and paste only to one, similar cell.It looks like following:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("E4")) Is Nothing Then
Range("E4").Copy
Range("E4").PasteSpecial xlPasteValues
End If
End Sub
Any help would be highly appreciated.
If I understand your problem correctly you want to copy the value to a new cell, for logging purposes? What I would do in this case is have another sheet for logging the values named "logger_sheet" I paste a value in cell a1 when the blomberg cell updates, copy the value into my logger_sheet cell a2 when it changes copy it to a3 then a4 etc.
Here is your updated code. It assumes you have a sheet named "logger_sheet" (if you dont have one, create it) to store all the previous values. When the blomberg cell updates, it copies the value and pastes it to the next avaliable logging_sheet cell. I have developed a function that finds the last used row in a specified sheet and column. Try it out
Also there is a line you can uncomment if you want to prevent excel from flashing, I labeled it in the code
Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
target_cell = "E4"
col_to_log_data = "A"
logging_Sheet = "logger_sheet"
If Not Intersect(Target, Range("E4")) Is Nothing Then
'uncomment this line to stop the "flashing"
'Application.ScreenUpdating = False
'gets the name of the current sheet
data_sheet = Range(target_cell).Parent.Name
Range(target_cell).Select
Selection.Copy
'gets the next free row from column a of the logging sheet (the next free row is
'the last used row + 1)
next_free_row = GetLastRowByColumn(CStr(col_to_log_data), CStr(logging_Sheet)) + 1
'pastes the value
Sheets(logging_Sheet).Range(col_to_log_data & CStr(next_free_row)).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'switches back to the data sheet
Sheets(data_sheet).Select
'make sure you turn screen updating on (if it was never off it still works)
Application.ScreenUpdating = True
End If
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'this finds the last row in a specific column
'PARAMS: col_to_check, the clumn we want the last row of
' Opt: sheet_name, the sheet you want to check last row of
' default is current sheet if not specified
'RETURN: the last row number used in the sheet
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetLastRowByColumn(col_to_check As String, Optional sheet_name As String)
'gets current sheet name
the_current_sheet = ActiveSheet.Name
'if the user didnt' specify a sheet use the current one
If (Len(sheet_name) = 0) Then
sheet_name = the_current_sheet
End If
'gets last row
GetLastRowByColumn = Sheets(sheet_name).Range(col_to_check & "65536").End(xlUp).Row
'returns to original sheet
Sheets(the_current_sheet).Select
End Function
If my answer solves your problem please mark it as the solution
How about this? It will transfer E4 to Sheet2 in a new row each time E4 changes.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Address = "$E$4" Then Sheets("Sheet2").Cells(Rows.Count, "F").End(xlUp).Offset(1) = Target
End Sub
I'm making the assumption you want to log every change of values.
I would advise to keep a log in a separate sheet. Let's call it LogSheet.
Sub WriteLog(ByRef r As range)
Dim Lastrow as integer
With ThisWorkBook.WorkSheets("LogSheet")
LastRow = .Cells(.Rows.Count,"A").End(XlUp).Row
.Range("A" & LastRow + 1).Value = Now & " - " & r.Value
End With
End Sub
This sub will basically write all changes in column A of our log sheet with a timestamp!
Now, we need to make changes to your code in order to tell, to make logs whenever there is a change. To do so, we're going to make a call to our function and tell to copy the content of the range("E4") (The one that gets updated all the time)
If Not Intersect(Target, Range("E4")) Is Nothing Then
'add this line
WriteLog(ActiveSheet.Range("E4"))
Try it now.