Copying formulas to last row of data - excel

I can see the question has been asked a couple of times in the forum, but as someone who doesn't really know macro, I cannot implement the code provided in the answers.
So I have recorded the below macro.
Macro6 Macro
'
'
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=INDEX('Account codes'!C[-1],MATCH(DATA!RC[4],'Account codes'!C[-2],0))"
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=INDEX('Account codes'!C2,MATCH(DATA!RC[4],'Account codes'!C1,0))"
Range("C2").Select
Selection.Copy
Range("E2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=INDEX('Account codes'!C2,MATCH(DATA!RC[4],'Account codes'!C1,0))"
Range("E2").Select
ActiveCell.FormulaR1C1 = _
"=INDEX('Account codes'!C2,MATCH(DATA!RC[3],'Account codes'!C1,0))"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E4")
Range("E2:E4").Select
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C4")
Range("C2:C4").Select
End Sub
In simple terms, I want Selection.AutoFill Destination:=Range("E2:E4") to fill down to the last row of data, and not just to E4. That is because the data can change in size.
How do I do this?

You seem to be overwriting some of the formulas with different relative/absolute references. It really doesn't seem to matter which is used as far as relative/absolute addressing is concerned but you have two distinct formulas for column E which reference two different cells on the data worksheet. I'll use the latter of the two.
Put all of the formulas into all of the cells at once. AutoFill is overrated and functionally redundant in this case.
The formulas for column C seem to be using a relative reference to a cell in column F. You can use that column to determine the last row to put formulas into.
sub buildFormulas()
dim lr as long
with worksheets("data")
lr = .cells(.rows.count, "F").end(xlup).row
.range(.cells(2, "C"), .cells(lr, "C")).formular1c1 = _
"=INDEX('Account codes'!C2, MATCH(RC7, 'Account codes'!C1, 0))"
.range(.cells(2, "E"), .cells(lr, "E")).formular1c1 = _
"=INDEX('Account codes'!C2, MATCH(RC8, 'Account codes'!C1, 0))"
end with
end sub

Related

Excel 2013 VBA select cell P for every row that has data in column A

Working on a function to put the filename in a specific column (P) of a file. I've got this running if I specify the cells to put the filename in (e.g. P1:P5).
However, I want to get this to run in the P column, but for all rows that have data in the A column.
I know I could do it for just the whole P column, but i dont want it to run on empty rows (they're of no use)
Code I have so far:
Sub Save_files()
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Rows("1:3").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("P2").Select
ActiveCell.FormulaR1C1 = "=CELL(""filename"")"
Range("P2").Select
Selection.Copy
Range("p1:p5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("D4").Select
End Sub
I want to replace Range("p1:p5").Select with something that selects every P cell that is on a row with data in A of the same row.
Things to note:
Column A will always have data
Columns B through to O may or may not have data
Thanks in advance!
I changed:
Range("p1:p5").Select
to:
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("p1:p" & LastRow).Select

VBA Macro: Paste underneath last cell in column with variable range

Title isn't the best so here a an overview.
I'm using VBA to copy select columns from one workbook to another, as what will be part of a larger automated program.
On the Workbook I am copying from, there are different sheets containing a "Stock Number" column. When pasting into my other workbook, I am trying to get these columns to merge into 1 single column (pasting below the last entry from the first sheet and so on).
Here is my current code:
Sub import_adam_article()
Windows( _
"copyfrom.xlsx" _
).Activate
Columns("F:G").Select
Selection.Copy
Windows("pasteinto.xlsx").Activate
Columns("A:A").Select
ActiveSheet.Paste
Windows( _
"copyfrom.xlsx" _
).Activate
Columns("N:N").Select
Application.CutCopyMode = False
Selection.Copy
Windows("pasteinto.xlsx").Activate
Columns("C:C").Select
ActiveSheet.Paste
Rows("1:1").Select
Selection.Delete Shift:=xlUp
NextRow = Range("A1").End(xlDown).Row + 1
Windows( _
"copyfrom.xlsx" _
).Activate
Columns("F:G").Select
Selection.Copy
Windows("pasteinto.xlsx").Activate
Range("A" & (NextRow)).Select
ActiveSheet.Paste
[A:C].Select
With Selection
.NumberFormat = "General"
.Value = .Value
End With
End Sub
The difficulty is that the amount of Stock Numbers will change every new file that comes through, so it needs to be able to adjust to varying amounts.
I can't seem to find a way to make it work and I've tried searching for answers elsewhere.
EDIT: The current issue with the code that it is selecting the next empty row to paste into, but only that cell, not a variable length down as required by the copyfrom column.

How to optimise my CONCATENATE vba script in Excel?

I've managed to put together a VBA script to automate the concatenating of strings in adjoining columns for the purpose of working with a Python/Applescript tool I've programmed for assisting with renaming of thousands of pdfs files.
There are four columns being worked on.
Col A - an article number for a particular computer in the organisation. 5 digits
Col B - the manufacturer's serial number for a given article number. Several digits long, but only the first 12 are important.
Col C - has a CONCATENATE function to derive the original name of a given PDF file related to a given serial number. "=CONCATENATE(LEFT(B2,12)&".pdf")"
Col D - has another CONCATENATE to help to define the new name of the PDF. "=CONCATENATE(A2&"-"&LEFT(B2,12)&".pdf")"
An example of what I am talking about...
"DMPQ44VZF4YD.pdf" gets renamed to "45872-DMPQ44VZF4YD.pdf"
I've recored a macro to record my using the CONCATENATE functions in cols C and D, then using autofill to drag that down manually to the bottom of the spreadsheet, then copying and pasting those (by value) to columns E and F and then deleting the columns A - D (inclusive) to leave behind only what I want. A messy way of doing things but it gets the job done.
Each Excel file can have a differing number of records/rows. I've arbitrarily set it to 1500 items in the VBA script. Please take a look...
Sub Macro1()
Macro1 Macro
Range("C2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(LEFT(RC[-1],12)&"".pdf"")"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C1500"), Type:=xlFillDefault
Range("C2:C174").Select
Range("D179").Select
ActiveWindow.SmallScroll Down:=-364
Range("D2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3]&""-""&LEFT(RC[-2],12)&"".pdf"")"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D1500"), Type:=xlFillDefault
Range("D2:D174").Select
ActiveWindow.SmallScroll ToRight:=-2
ActiveWindow.SmallScroll Down:=-528
Columns("C:D").Select
Selection.Copy
Columns("F:F").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("A:E").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("D5").Select
Dim Rng As Range
For Each Rng In ActiveSheet.UsedRange
If Rng.Value2 = ".pdf" Or Rng.Value2 = "-.pdf" Then Rng.ClearContents
Next Rng
End Sub
It works well but can take a while to process (due to the arbitrarily high number of possible records in a given sheet, perhaps as well as the 'for' loop at the end to get rid of any trailing ".pdfs" and "-.pdfs" that are a hangover from otherwise empty cells affected by the CONCATENATE function). Is there any way of making the more efficient when dealign with a small number of records or perhaps making it easily more scalable?
Here is a link to the code if that helps.
Thanks once again.
Will
You may give this a try...
Sub RenamePDFFiles()
Dim lr As Long
lr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With Application
.Calculation = xlCalculationManual
.EnableAutoComplete = False
.ScreenUpdating = False
End With
Range("C2:C" & lr).Formula = "=IF(B2="""","""",LEFT(B2,12)&"".pdf"")"
Range("C2:C" & lr).Value = Range("C2:C" & lr).Value
Range("D2:D" & lr).Formula = "=IF(AND(A2="""",B2=""""),"""",A2&""-""&LEFT(B2,12)&"".pdf"")"
Range("D2:D" & lr).Value = Range("D2:D" & lr).Value
Columns("A:B").Delete
With Application
.Calculation = xlCalculationAutomatic
.EnableAutoComplete = True
.ScreenUpdating = True
End With
End Sub
For formula in column D, I have used AND function for the logical test so that if both columns A and B are empty, the corresponding cell in column D will also be empty. If required, change it to OR condition.

delete cells but not rows

I have an excel sheet where I am pulling data from other worksheets into separate columns per worksheet I pull from. I am trying to find any duplicates in any of my columns and delete all the duplicates (for example: if there are three of the code 12gb, I want to be left with one 12gb). I want this so that I can count how many unique values there are (automatically) and then populate a graph automatically. I have tried many different formulas to do this but I am thinking a VBA code is needed, however I have never used that coding before so I am not sure what to do.Below is an example of three columns of my excel sheet:(I wasn't able to post images/excel sheets)
12gb sdf vfg
22rg tttyhg dsf
dfg455 ggff df
fgfg fff vcs
4redd ccv dfgh
56ff 66hg 66y
yygf 66y 56ff
66ygt yggfg 12gb
ghhg
vfg
This is a hackish macro it relies on specific columns and placements so I'm not a big fan of this solution.
It was generated by recording the manual tasks I did
adding a row to denote end of columns
copying the columns 2 and 3 to the end of column 1.
removing the duplicates in column a
then manually creating the 3 columns again. based on the end of column notes added.
.
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Range("A12").Select
ActiveCell.FormulaR1C1 = "1----"
Range("B12").Select
ActiveCell.FormulaR1C1 = "2----"
Range("C12").Select
ActiveCell.FormulaR1C1 = "3----"
Range("B1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Cut
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range("A13").Select
ActiveSheet.Paste
Range("B13").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Cut
Range("A13").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range("A25").Select
ActiveSheet.Paste
Columns("A:A").Select
ActiveSheet.Range("$A$1:$A$46").RemoveDuplicates Columns:=1, Header:=xlNo
Range("A13:A22").Select
Selection.Cut
Range("B1").Select
ActiveSheet.Paste
Range("A23").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("C1").Select
ActiveSheet.Paste
Range("B13").Select
Now this assumes Row data isn't relevant. If it is... this will not work. as Excel deletes the duplicates.
you could do something like this, although i'm sure there are more elegant ways. in principle i just put each value into an array after checking if the value is not already in the array:
Sub del_values()
Dim last_row, last_col, size, y As Integer
Dim arr() As Variant
'finding the last row and last column and calculating the possible size of the array
last_row = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
last_col = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
size = last_row * last_col
y = 0
'adjusting the array-size
ReDim arr(size)
For Each cell In ActiveSheet.Range(Cells(1, 1), Cells(last_row, last_col))
'avoiding blank cells
If cell.Value > "" Then
'checking if value is already in the array - if not, add it to the array and increase y - if it is, clear the contents of the cell
If IsError(Application.Match(cell.Value, arr, 0)) Then
arr(y) = cell.Value
y = y + 1
Else
Cells(cell.Row, cell.Column).ClearContents
End If
End If
Next
End Sub
i was not sure what you wanted to do with the cells containing duplicates, so i just cleared the contents - you could of course just delete them with
Cells(cell.Row, cell.Column).delete
by the way, y is equal to the number of unique values, if you want to use it directly.

Creating a Loop

I recorded a macro to reference data on Sheet1 and pull it over to Sheet2.
I need to continue until there is no more data present on Sheet1(or Row 209).
Sub Macro1()
Range("A1").Select
ActiveCell.FormulaR1C1 = "=Sheet1!RC"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-1]C"
Range("A3").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-2]C"
Range("A4").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-2]C"
Range("A5").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-3]C"
Range("A6").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-4]C"
Range("A7").Select
End Sub
It looks like from your code that you are simply copying and pasting from Sheet1 to Sheet2, but for each row you go down in Sheet2, you go up a row in Sheet1. In other words, "=Sheet1!R[-x]C" makes it look like you are going up a row by x.
What your code is showing is a step-by-step process of selecting each cell, then changing it. Why not do this all at once without the .Select statments?
For example, a For...Next loop could do this:
For i = 1 To 209
Worksheets("Sheet2").Cells(210 - i, 1).Value = _
Worksheets("Sheet1").Cells(i, 1).Value
Next
This copies the contents of the cells (the .Value property) directly.

Resources