Auto filling formula VBA - 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

Related

VBA Macro to Autofill a cell

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

Select all data except heading, potential empty rows

I require a macro to select all valid data, copy and paste it into a new sheet and save the sheet. he issue is that there may be no data in a sheet as this will be run for 50+ sheets
I have the below but if there is no data then it selects 1mio+ empty rows.
Sub InvoiceBackup()
Sheets("ASM001").Select
Range("A5").Select
Range( _
ActiveCell.End(xlDown).Offset(0, 14), _
ActiveCell.Offset(1, 0)).Select
End Sub
Please help?
In my code I test whether the cell under the header is empy as such
Sub InvoiceBackup()
Dim wksht As Worksheet
Dim rng As Range
Set wksht = Sheets("ASM001")
Set rng = wksht.Range("A5")
If Not IsEmpty(rng.Offset(1, 0)) Then
Set rng = Range(rng.End(xlDown).Offset(0, 14), rng.Offset(1, 0))
End If
End Sub
I know lots of people who search up from the bottom of the sheet for the last nonempty cell. My personal opinion on this is that it is too dependant on the version of Excel for me to be comfortable with it. If another user has a version with a different final row number, that could break your code.
Try something like this in the beginning of the macro:
Range("A1048576").End(xlUp).Select
If ActiveCell.Row = 5 Then Exit Sub 'because there are no data...

Fill down column according to colum in another sheet

I've been a longtime viewer of this place and I love it! I've never needed to post because I've been able to find everything. However, today I am stumped and I cannot find an answer here so forgive me if this has been addressed.
The question is this:
I want to copy ColumnA (starting say, A2) from SHEET1 into ColumnB (starting B8) of SHEET2.
My problem is that the source column (SHEET1:ColumnA) has a dynamic number of rows every instance the workbook is used. I also do not want to fill down to the end of the sheet or display zeros etc.
I perceive this as a filldown problem but sourcing from another sheet. Though I may be wrong about that and cannot make it work myself.
Thanks very much in advance.
Try this:
sub copyToOtherSheet()
dim startRowASht1 as int
dim startRowSht2 as int
dim loopr as Boolean
dim counter as long
loopr = True
counter = 0
startRowSht1 = 2
startRowSht2 = 8
Do While loopr = True
Worksheets("Sheet2").Range("B" & Cstr(startRowSht2 + counter)).value = Worksheets("Sheet1").Range("A" & Cstr(startRowSht2+counter)).value
if Cstr(worksheets("Sheet1").Range("A" & Cstr(startrowsht2 + counter)).value) = "" then
loopr = False 'you reached an empty cell and it stops copying
else
counter = counter + 1
end if
End Sub
Public Sub a()
With Sheets("Sheet2")
.Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Copy Destination:=Sheets("Sheet1").Cells(8, 2)
End With
End Sub
If you are willing to use a macro:
Sub copyRange()
Dim rSource As Range
Set rSource = Range(Sheet1.Cells(2, 1), Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp))
Range(Sheet2.Cells(8, 2), Sheet2.Cells(Sheet2.Rows.count,2)).Clear
Range(Sheet2.Cells(8, 2), Sheet2.Cells(7 + rSource.Rows.Count, 2)).Value = rSource.Value
End Sub
This assumes that there is nothing below the contiguous range of values in column A on Sheet1, and that in Sheet2 you want to completely clear out whatever is in column B from row 8 down to the bottom. (If your range in column A of Sheet1 gets smaller from one invocation to the next, you don't want to leave any remnants in Sheet2)

Counting non blank cell results without looping in Excel VBA -- e.g., with Specialcells

Here is the code I'm trying to count with in VBA, hoping to return
a count return variable of "3" from 'FormulaResultCount'. Why can't I
count what is visibly returned by the formulas within each cell; from the grey box (see photo below)?
Sub countNonBlanks()
Worksheets("Sheet1").Select
Range("C:C").Select
FormulaResultCount = Selection.SpecialCells(xlCellTypeFormulas).Count
'SpecialCells options from MSFT
' xlCellTypeAllFormatConditions. Cells of any format -4172
' xlCellTypeAllValidation. Cells having validation criteria -4174
' xlCellTypeBlanks. Empty cells 4
' xlCellTypeComments. Cells containing notes -4144
' xlCellTypeConstants. Cells containing constants 2
' xlCellTypeFormulas. Cells containing formulas -4123
' xlCellTypeLastCell. The last cell in the used range 11
' xlCellTypeSameFormatConditions. Cells having the same format -4173
' xlCellTypeSameValidation. Cells having the same validation -4175
' xlCellTypeVisible. All visible cells
'
End Sub
See formula as reference:
Note: Since I will have many more cells when working dynamically, loops will likely slow the process down too much. Also, I tried using CountA without result.
Maybe this:
FormulaResultCount = WorksheetFunction.CountIf(Range("C:C"), "?*")
Thus counting all cells in range that start with any character?
xlCellTypeFormulas. Cells containing formulas -4123
This would not return the cell based on their values but if they have any formula or not. As per your worksheet, you should get 5
Also, PLEASE PLEASE do not use .Select INTERESTING READ
Your code can also be written as
FormulaResultCount = Worksheets("Sheet1").Columns(3).SpecialCells(xlCellTypeFormulas).Count
Another Tip: When using SpecialCells, use appropriate error handling so that if there are no cells which match the SpecialCells criteria, your code won't break. See this example.
Sub Sample()
Dim ws As Worksheet
Dim Rng As Range
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
On Error Resume Next
Set Rng = .Columns(3).SpecialCells(xlCellTypeFormulas)
If Err <> 0 Then
MsgBox "No Cells with formulas were found"
Exit Sub
End If
On Error GoTo 0
End With
FormulaResultCount = Rng.Count
Debug.Print FormulaResultCount
End Sub
FOLLOWUP From Comments
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
Debug.Print Evaluate("=COUNTA(C1:C" & lRow & _
")-COUNTIF(C1:C" & lRow & ","""")")
End With
End Sub
What you really might want is:
FormulaResultCount = Evaluate("CountA(C:C)")
I just learnt about the evaluate command. It's awesome!
And it gives you 3 :)
You can do this without VBA, using only formulas.
=ROWS(range)*COLUMNS(range)-COUNTBLANK(range)
If you're trying to do this in VBA, you can use this:
Function non_blank_cell_results_count(r As Range) As Long
non_blank_cell_results_count = r.Cells.Count - WorksheetFunction.CountBlank(r)
End Function

How to sum columns for a selected range using VBA?

After I have selected a range containing numerical values, I want to, via VBA, input a =SUM formula at the bottom of each column, i.e. on the row after the last selected row. For each column it should sum all of the values in the corresponding column of the entire selection.
How can I do this?
Right now, I am using the code given by the macro recorder: ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)". The problem is when my range gets bigger than 10 rows it will not take the rows above the bottom 10 into consideration.
Here is a simple non-VBA Approach.
Select the cells where you want the sum and press Alt-=.
SNAPSHOT
And here is a one-line VBA code that does the same thing.
Sub AutoSum()
'~~> After you select your range
Application.CommandBars.ExecuteMso ("AutoSum")
End Sub
This works:
Sub MakeSums()
Dim source As Range
Dim iCol As Long
Dim nCol As Long
Dim nRow As Long
Set source = Selection
nCol = source.Columns.Count
nRow = source.Rows.Count
For iCol = 1 To nCol
With source.Columns(iCol).Rows(nRow).Offset(1, 0)
.FormulaR1C1 = "=SUM(R[-" & nRow & "]C:R[-1]C)"
.Font.Bold = True
End With
Next iCol
End Sub
Example:
You could also do something like this without VBA:
=SUM(OFFSET(INDIRECT(CELL("address")),1-ROW(),0,ROW()-1,1))
This will sum all cells above the cell in which the formula exists.
Here is a quick trick to sum selected cells in vba code.
Private Sub Sum_Click()
MsgBox Application.Sum(Range(Selection.Address))
End Sub
This is what I was searching for when I landed on this thread so maybe it will help someone.