I am trying to use macro recorder in Excel to record a macro to fill down a column of cells, however because the fill down each time is a different number of cells it either fills down to short or too long and this seems to be because the macro identifies the cell range and its fixed.
Is there anyway that I can get it to fill down to the last populated neighbouring cell. E.g. AutoFill down column E until it reaches the last populated row in column D. I have looked at some examples on here but the code all looks very different so not sure if it can be done with macro recorder or I have to get someone to write some code or is it something that has to be done manually?
This is the code that I have in the macro.
ActiveCell.FormulaR1C1 = _
"=IF(MONTH(RC[-1])>3,"" ""&YEAR(RC[-1])&""-""&RIGHT(YEAR(RC[-1])+1,2),"" ""&YEAR(RC[-1])-1&""-""&RIGHT(YEAR(RC[-1]),2))"
Selection.AutoFill Destination:=Range("E2:E1344")
'Selection.AutoFill Destination:=Range("E2:E1344")
Range("E2:E1344").Select
If anyone can help i'd be extremely grateful
Untested....but should work.
Dim lastrow as long
lastrow = range("D65000").end(xlup).Row
ActiveCell.FormulaR1C1 = _
"=IF(MONTH(RC[-1])>3,"" ""&YEAR(RC[-1])&""-""&RIGHT(YEAR(RC[-1])+1,2),"" ""&YEAR(RC[-1])-1&""-""&RIGHT(YEAR(RC[-1]),2))"
Selection.AutoFill Destination:=Range("E2:E" & lastrow)
'Selection.AutoFill Destination:=Range("E2:E"& lastrow)
Range("E2:E1344").Select
Only exception being are you sure your Autofill code is perfect...
This example shows you how to fill column B based on the the volume of data in Column A. Adjust "A1" accordingly to your needs. It will fill in column B based on the formula in B1.
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
ActiveCell.Offset(0, -1).Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Related
I'd like to autofill cells across and above a dynamic range.
I have a line of numbers in row 3 and would like to put the word "Customer No." in the cell above each one.
I do this by copying A2 and pasting into C2 then dragging across
Via VBA macro recorder the code I get looks like this
Selection.Copy
Range("C2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("C2:E2"), Type:=xlFillDefault
Range("C2:E2").Select
I was wondering if there's a way to create an autofill across a dynamic range as the number of cells in row 3 will change from time to time?
Thanks
You could do it like this:
With ActiveSheet
.Range("C3", .Cells(3, Columns.Count).End(xlToLeft)).Offset(-1).Value = .Range("A2").Value
End With
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
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.
The problem: the dates displayed in my excel files are not the actual dates entered into each cell. For example, I might visually see 04/18/2019 but when I click on the cell, it shows 04/18/2019 06:48:00PM. This becomes an issue when I run the macro I use to convert my xlsx file to txt. The txt file generated will show 04/19/2019 06:48:00PM in the date field rather than what I want, 04/18/2019.
The current fix I'm using is to insert columns next to the date columns, copy the date columns and paste values into the new inserted columns, and then deleting the inserted columns. This was accomplished through recording a macro (I'm a noob if you couldn't tell).
That rudimentary fix does actually work quite well at generating the output I need. Except one problem: if there are any blanks in the date columns, it pastes in 01/01/1900. Blanks in date columns is fairly common in the work I do so this is a major problem.
I tried adding this If in after the inserting/pasting values/deleting code:
'Fix Date format in columns A and C
'
Columns("B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-1],""mm"/"dd"/"yyyy"")"
Range("E1").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-1],""mm"/"dd"/"yyyy"")"
Range("B1").Select
Selection.AutoFill Destination:=Range("B1:B" & EndRow)
Range("E1").Select
Selection.AutoFill Destination:=Range("E1:E" & EndRow)
Range("B1:B" & EndRow).Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E1:E" & EndRow).Select
Selection.Copy
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("E").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("B").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
If Range("A1:A") = "01/01/1900" Then ClearContents
'
But I get this error "Compile Error: Sub or Function not defined", with the word Range within the If statement highlighted. I don't understand why it isn't recognizing range since it is used just a few lines up without issue. I have to be doing something wrong but I'm lost. Any ideas?
PS - The If is just a means to an end as far as remedying the blanks, but I'm sure there's a better way to convert these date columns to text or to the date format I want. If you have any recommendations for some easier way to achieve the same results I am all ears.
Thanks guys I really appreciate it!
Range("A1:A")
That's a google-sheets reference for 'everything from A1 down to the last used cell in column A' not a VBA style. Either reference the entire column (e.g. Range("A:A")) or modify the end row with your EndRow var (e.g. Range("A1:A" & EndRow)).
The formating mask used in the VBA application of the TEXT formula seems wrong. When using a quote within a quoted string,double up the quote once every time it ix used. The TEXT formula returns a string (i.e. text); you do not need to attempt any further conversion.
ActiveCell.FormulaR1C1 = "=TEXT(RC[-1],""mm/dd/yyyy"")"
Both xlR1C1 and relative styled xlA1 formulas be applied to all cells at once. A Union of the target cells in columns B and E further expedites the formula insert.
Range("B1:B" & EndRow & ",E1:E" & EndRow).formular1c1 = "=TEXT(RC[-1],""mm/dd/yyyy"")"
You cannot directly compare a multiple cell range to a single value. Either loop through the cells or use a wide-range comparison like Range.Find, the worksheet's MATCH function or an AutoFilter to expose the matching cells as xlCellTypeVisible.
dim m as variant
m = application.match("01/01/1900", ActiveSheet.Range("A:A"), 0)
do while not iserror(m)
ActiveSheet.Cells(m, "A").clearcontents
m = application.match("01/01/1900", ActiveSheet.Range("A:A"), 0)
loop
If you've read down this far, the easiest method of stripping the date out of a date-time is Text-to-Columns. Simply discard anything after the 10th character (e.g. mm/dd/yyyy from mm/dd/yyyy hh:mm amp/pm).
With ActiveSheet.Columns("A")
.TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(10, 9))
.NumberFormat = "mm/dd/yyyy"
End With
I would humbly suggest you take some time to investigate How to avoid using Select in Excel VBA. If you continue to develop VBA to make your Office applications more efficient, you should start using recommended methods as soon as possible.
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.