Selecting Range Dynamically till the last cell in VBA - vba

I have a VBA code with the following.
Selection.AutoFill Destination:=Range("H2:J2002")
This can select till the last entry in column J when it has exactly 2002 entries. What I want is a general one which can select between H2 and the last entry in J column. I found the following
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
But I am not understanding, how I can use the value of Lastrow to select the last cell in column J.

Lastrow = ActiveSheet.Cells(Rows.Count, 10).End(xlUp).Row
'lastrow now holds last occupied cell in column 10 ie J
Selection.AutoFill Destination:=Range("H2:J" & lastrow)

Related

Excel VBA - Select All Columns & Rows After Last Occupied Column & Row

I'm trying to figure out the code that identifies the last occupied column in the sheet then deletes all columns after that. I'm also trying to figure out the code that identifies the last occupied row in the sheet then delete all rows after that.
So far I've got the idea that I will need to use Rows.Count function but I'm having trouble getting it to select the entire rows after the last occupied row. Same for columns... This is what I've come up with so far which only identifies the last occupied row. Does anyone know how to get it to now select the entire rows after this? And similarly for the entire columns? I can't seem to figure out the code to select the last occupied column like I can with rows... Thank you in advance
Rows:
Sheets("ppCopy").Cells(Rows.Count, 1).End(xlUp).Row
You need to read the code and try to make sense of it and the answer will come to you.
Break down what you already know.
Sheets("ppCopy").Cells(Rows.Count, 1).End(xlUp).Row
Rows.Count = Last Available Row
End(xlUp) = move UP from the last available row (Rows.Count) to the last used row.
How do you get the column then?
Sheets("ppCopy").Cells(1, Columns.Count).End(xlToLeft).Column
Columns.Count = Last Available Column
End(xlToLeft) = Move Left from the last available column (Columns.Count) to the last used Column.
Here is how to delete unused Rows and Columns:
Sub deleteUnused()
Dim lastRow As Long, lastColumn As Integer 'there are a lot of rows compared to columns
Dim lastLetter As String, firstLetter As String
Set wk = ThisWorkbook
With wk.Sheets("Sheet1")
'Get last used rows and columns based on valued from Column A and Row 1
lastRow = .Cells(Excel.Rows.Count, 1).End(Excel.xlUp).Row
lastColumn = .Cells(1, Excel.Columns.Count).End(Excel.xlToLeft).Column
'Delete Rows
.Rows("" & (lastRow + 1) & ":" & Excel.Rows.Count & "").EntireRow.Delete Shift:=xlUp
'Delete columns, tricky because you need the Column Letters instead of the numbers
lastColumn = lastColumn + 1
firstLetter = Split(.Cells(, lastColumn).Address, "$")(1)
lastLetter = Split(.Cells(, Excel.Columns.Count).Address, "$")(1)
.Columns("" & firstLetter & ":" & lastLetter & "").EntireColumn.Delete Shift:=xlLeft
End With
End Sub
J Doe
Here is a code that will search for the value in any cell on any column and then select and delete all rows after that and do the same for the columns. No a very technic or something but will do the work and also give you some ideas. It will also include formulas that display empty cells.
Hope this help.
Sub DeleteRowAndColumns()
With ThisWorkbook.Sheets("ppCopy")
'find any cell no empty in a row in any row
.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Offset(1, 0).EntireRow.Select
'select all the rows
.Range(Selection, Selection.End(xlDown)).Select
Selection.Delete ' clear all the rows
'find the last value in any column
.Cells.Find(What:="*", SearchOrder:=xlColumns, SearchDirection:=xlPrevious, LookIn:=xlValues).Offset(0, 1).EntireColumn.Select
'select columns
.Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete 'clear columns
End With
End Sub

Counting Records/Rows

I have a macro that saves an excel file down to .txt. I need to insert a record count to the top of the .txt file ("Records|123"). I have the row inserted, I have the word Records in A1, now I'm trying to figure out how to get a row count in B1. I've tried CountIf, LastRow, EndRow and now COUNT. I'm subtracting 2 because row 1 is the record count and row 2 is column headers, and I'm referencing column D because columns A-C contain numbers and it didn't like that either. Here is what I have:
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Records"
Range("B1").Select
ActiveCell.Value = (EndRow - 2)
ActiveCell.FormulaR1C1 = "=COUNT(D:D)"
This is giving me Records|0. Does anyone have any ideas on how to get this to work? Or can you point me in a different direction? Thank you in advance.
Something like this.
Dim ws As Worksheet
Dim lr As Long
ws = ThisWorkbook.Sheets("Sheet1")
lr = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
With ws
.Range("B1") = lr - 2
End with
You could have just gotten a row count before you inserted the header row.
dim newvariable as long
newvariable = Thisworkbook.worksheets("yoursheet").UsedRange.Rows.Count
And then insert your new header row and place that value in the cell like:
Thisworkbook.worksheets("yoursheet").Range("a1").Value = newvariable

Autofill column across dynamic start

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

Copy Pasting Range of different length using VBA

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 :)

Filter based on multiple cell values in separate sheet then loop through results

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.