I am trying to write a code to autofill the final column in a worksheet to the right x times.
I have the code which will pick up the last column :
With ActiveSheet
LC = .Cells(3, .Columns.Count).End(xlToLeft).Column
End With
Columns(LC).Select
and also code that would autofill across if I specify which specific columns
Selection.AutoFill Destination:=Columns("BE:BQ"), Type:=xlFillDefault
What I am struggling with is how to replace the columns "BE:BQ" with the required code which is linked to the original Last Column (LC).
Ideally I would like it to autofill across to add, say 10, new columns. Do you have any advice?
Ideally I would like the code to cycle through all the worksheets in my workbook - but this is probably a bit advanced for me!
Thank you very much in advance.
UPDATE
Thank you for your suggested comments. I have amended the code as below. This firstly appeared to work perfectly. However, I have since come across two issues.
Issue 1 - on some sheets when it fills across a date field which is in row 3 does not fill. It just copies across the date exactly the same as the one in the last row (i.e. 01/06/2017 but is displayed as Jun-17). I would like this to fill across a month at a time.
Issue 2 - in row 2 there is a date which is the last day of the pervious month. This is currently entered manually but as I have developed the macro I would like this to be changed to a formula equal to date in the cell below minus 1 day. I tried to do this using the following formula but it went completely awry!
sht.Cells(2, LC).Formula = "=" & Cells(3, LC) & "-1"
Any advice on how to fix these two issues would be most appreciated.
Dim LC As Integer
Dim LR As Long
ActiveSheet.Unprotect
With ActiveSheet
LC = .Cells(3, .Columns.Count).End(xlToLeft).Column
LR = .Cells(Rows.Count, LC).End(xlUp).Row
End With
Range(Cells(1, LC), Cells(LR, LC)).Select
Selection.AutoFill Destination:=Range(Cells(1, LC), Cells(LR, LC + 10)),Type:=xlFillDefault
Try this. I'm not sure about the A2 bit as the code suggests the autofill starts at row 3 but can jus replace 3 with 2 in the code if it should also be included.
Sub x()
Dim LC As Long, LR As Long, ws As Worksheet
For Each ws In Worksheets
With ws
LC = .Cells(3, .Columns.Count).End(xlToLeft).Column
LR = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(3, LC), .Cells(LR, LC)).AutoFill Destination:=.Range(.Cells(3, LC), .Cells(LR, LC + 10)), Type:=xlFillDefault
.Cells(3, LC).AutoFill Destination:=.Cells(3, LC).Resize(, 10), Type:=xlFillMonths
.Range("A2").Formula = "=A3-1"
End With
Next ws
End Sub
Related
I'm trying to get this cell to total a range from another worksheet but I keep getting stuck. The range rows and columns vary but the starting point is always C2. I need to total from C2 to the rest of the used range (aka exclude columns A and B as well as row 1 but include everything else).
Please help if you can.
Range("A1").Formula = "Wage Totals"
Range("A2").Formula = "=SUM(" & ActiveWorkbook.Sheets("Wage").Range(Cells(2, 3), Cells.SpecialCells(xlCellTypeLastCell)).Address(False, False) & ")"
Check out this link Using SUM() in VBA
You can use that idea to change your code to:
Dim lastCol As Long
Dim lastRow As Long
lastCol = Sheets("Wage").Cells(1, Sheets("Wage").Columns.Count).End(xlToLeft).Column
lastRow = Sheets("Wage").Cells(Sheets("Wage").Rows.Count, 1).End(xlUp).Row
Range("A1").Value = "Wage Totals"
Range("A2").Value = WorksheetFunction.Sum(Sheets("Wage").Range(Sheets("Wage").Cells(2, 3), Sheets("Wage").Cells(lastRow, lastCol)))
This is pretty naive solution tho becuase it assumes the usedrange limits can be found by looking for last used row on Col "A" and last used col on Row 1. You can change that method of finding the limits.
http://i.stack.imgur.com/93bt7.png
Hi,
I am trying to work with a code I have made but am having some trouble.
If you look at my photo above, in cell B3 I have a CUSIP. What I want to do is copy that CUSIP and paste it in each row of info for that CUSIP (so rows A4 till A8). Then I want to move to the second CUSIP in J3 (the CUSIPS are all in row 3 and 8 columns apart) and then paste the CUSIP in rows J4 to J35.
I want to keep doing this over and over for 1000 securities but the issue is that the rows differ in length.
My code is working until I get to the last piece of code which I have put in as a comment. It works but is static. Only works for moving from the 1st to 2nd security then fails. I am trying to think of a dynamic way for me to move from the cell which the CUSIP is last pasted in to the third row and corresponding column everytime (column will be 9 apart every time from the last pasted cell).
Here it is:
Sub CUSIP_Copy_Paste()
Dim LastRow As Long
Dim LastCol As Long
Dim c As Long
Dim r As Long
Range("B3").Select
LastCol = Cells(4, Columns.Count).End(xlToLeft).column
For c = 2 To LastCol Step 8
LastRow = Cells(Rows.Count, c).End(xlUp).row
ActiveCell.Copy
Cells(4, ActiveCell.Offset(1, -1).column).PasteSpecial xlPasteValues
For r = 5 To LastRow
Cells(r, ActiveCell.Offset(1, 0).column).PasteSpecial xlPasteValues
Next r
''''''ActiveCell.Offset(-5, 9).Select
Next c
End Sub
Thanks!
Your error lies in the final offset. Instead of -5, put in a variable, preferrably the variable which is the difference between the end of the rows count and the beginning, which is always 3.
That is to say, Offset(3 - lastRow, 9)
You almost had it friendo :)
I am looking for code for two different types of selection. One code would select in an L shape all of the rows in one column and all of the columns in one row. In the example of having data in the range A1:A10, and data in row 10 only from col A - K. The selection would look like an L. How can you do this without knowing how many rows or columns have data in them?
The second code would have the same data, but need to select the whole range A1:K10 in that example, but the code would need to select whatever range had the data.
i found the answer. i have to do a union. here is the code with the union at the end.
Sub mywork()
Dim ws As Worksheet
Dim lRow As Long, lCol As Long
Dim rng As Range
'~~> Set this to the relevant worksheet
Set ws = [Sheet1]
With ws
'~~> Get the last row and last column
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lCol = .Cells(lRow, .Columns.Count).End(xlToLeft).Column
'~~> Set the range
Set rng = .Range(.Cells(lRow, 1), .Cells(lRow, lCol))
End With
Set rng = Application.Union(Range("A1:A" & lRow), rng)
rng.Select
End Sub
activesheet.usedrange.address should tell you the used range.
In your case something like this should work: [sheet1].usedrange.select (Replaces all the code in the module)
The benefit here is the fact that you are not hard coding "A1:A" against the last identified cell, works well if you have blank rows at the top.
I am working with a file that has 10 columns with varied data in each one. There is only one column that has (fairly) consistent data. I will attach the file so that hopefully it will help with what I am trying to do.
I want to have the unique values copy over to another worksheet. There are multiple ACD options, but I only want ACD to be copied IF the cell above it contains the value RING. Additionally, I would like to copy over the first TIME column, if possible the second. If necessary I will have a macro change the names to the second column to length.
Data File
I know that advanced filters can be utilized but I have not yet been able to figure out how to properly set it up.
Any tips would be greatly appreciated!
Is this what you needed? I'm pretty new to VBA though but it works.
Sub CopyData()
Dim lastrow As Long, LocY As Long, lastcopy As Long
Dim source As Worksheet, dest As Worksheet
Set source = Worksheets("Sheet1")
Set dest = Worksheets("Sheet2")
lastrow = source.Cells(Rows.Count, 1).End(xlUp).Row 'Checks for the last row that contains data in the source
lastcopy = dest.Cells(Rows.Count, 1).End(xlUp).Row + 1 'Checks for the last row with data in the destination and move down by one to prime for data entry
For LocY = 2 To lastrow 'LocY referring to current location
If source.Cells(LocY, 7).Value = "RING" Then 'Check if current locations at column 7 in source sheet contains the value RING
source.Cells(LocY, 2).Copy
dest.Cells(lastcopy, 1).PasteSpecial xlPasteValues 'pastes the value into the last row of destination sheet.
source.Cells(LocY, 7).Copy
dest.Cells(lastcopy, 2).PasteSpecial xlPasteValues
source.Cells(LocY, 10).Copy
dest.Cells(lastcopy, 3).PasteSpecial xlPasteValues
lastcopy = lastcopy + 1 'moves the target row in the destination down by one to prime for data entry.
End If
Next
End Sub
Ok,
Hopefully this isn't too convoluted. I'm trying to filter a large number of transactions based on customer ID number. I have a list of about 60 important customers I need to track in a separate sheet. It has their customer ID number and then their name and other data. So everyday I'm taking about 20,000 transactions and filtering them manually. Then going through and copying and pasting the first instance of each transaction for the day into another sheet.
So Far this is what I have:
Dim Arr() AS Variant
Arr = Sheet2.range(“A1:A60”)
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
ActiveSheet.Range(“A1:A” & LastRow).AutoFilter Field:=1,_
Criterial:=Arr, Operator:=xlFilterValues
Dim r As Long, endRow As Long, pasteRowIndex As Long
pasteRowIndex = 1
For r = 1 To LastRow
If Cells(r, Columns("A").Column).Value <> Cells(r + 1, Columns("A").Column).Value
Then Rows(r).Select
Selection.Copy
Sheets("Sheet3").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste
pasteRowIndex = pasteRowIndex + 1
Sheets("Sheet1").Select
End If
Next r
As of now it's untested because I'm on vacation. Does this code look proper? If not, what can I do better?
Thanks
A few notes:
Change Columns("A").Column to just 1, there is no need to have it like that since you aren't checking other columns.
For LastRow it may be easier to simply use Cells(1,1).End(xlDown).Row
From what I can see your if command is checking the cell after for the same ID number. This would imply that the last transaction from that ID number is the only one being passed. If you have headings the first row then you could use
If Cells(r, Columns("A").Column).Value <> Cells(r - 1 1, Columns("A").Column).Value
and start with r = 2
Also it seems as though when you are filtering you are only filtering the A column. Change to the following and it should work
LastCol = Cells(1,1).End(xlToRight).Column
ActiveSheet.Range(Cells(1,1),Cells(LastRow,LastCol)).AutoFilter Field:=1,_
Criterial:=Arr, Operator:=xlFilterValues
For code simplicity you can also use Dim r, endRow, pasteRowIndex As Long and do not forget to define Dim LastRow as Integer and similar for LastCol if you decide to use it.
If there are still any issues with this when you return please feel free to let me know.