Excel VBA select new usedrange portion of a column - excel

Hi All.
I need your help please.
I want to apply a formula to the new rows that I've just added. I have a line of code I use for a full set of data, but I'm not sure how to modify it, or if there is a better way to do it.
I'm a bit out of my league with this line of code, I understand what it's doing but I didn't write it.
Sheets("Closed Loop").Range(varPastePos).Offset(0, 2).Resize(ActiveSheet.UsedRange.Rows.Count - 1, columnsize:=1).FormulaR1C1 = "My Formula"
varPastePos is the position the new data was pasted, in this case $F$28
Any ideas?

Use Range().FillDown to extend a pre-existing formula.
Dim lastRow As Long
lastRow = Range("F" & Rows.Count).End(xlUp).Row
Range("A2", "A" & lastRow).FillDown
You can FillDown multiple columns at once like this:
Range("A2", "D" & lastRow).FillDown
You can do it all in one line like this:
Range("A2", Range("F" & Rows.Count).End(xlUp)).FillDown

.UsedRange would also include formatted blank cells so it is not reliable for finding the last used row.
Set ws = Sheets("Closed Loop")
Set cell1 = ws.Range(varPastePos) ' F28
Set cell2 = cell1.End(xlDown) ' F32 ? the last cell with data below F28. Similar to clicking on F28 and pressing Ctrl + down
Set rngF = ws.Range(cell1, cell2) ' F28:F32
Set rngH = rngF.Offset(, 2) ' H28:H32
rngH.FormulaR1C1 = "My Formula"

Related

Debug countif and autofill in excel VBA, criteria doesn't work

I will need a function to count the number of each item in column J and show the result on column K. But this code I show below keep saying that the criteria part RC[-2] is wrong. After the countif function, I will need it to be able to autofill in whatever lines are given so that I can apply this code to other files as well.
I used Macro to generate some code to start. And also try this earlier:
paste_countPTD = Worksheetfunction.CountIf(paste_conPTD,RC[-2]).
The criteria part seemed wrong.
Dim paste_conPTD As Range
Set paste_conYTD = Range("J2:J" & Range("A" & Rows.Count).End(xlUp).Row)
Range("K1").Select
ActiveCell.FormulaR1C1 = "Count_PTD"
Range("K2").Worksheetfunction.countif(paste_conPTD,RC[-2])
I appreciate any suggestion to make this code works. To do the countif for a column and autofill the formula.
You can try this code
Dim paste_conPTD As Range
Set paste_conYTD = Range("J2:J" & Range("A" & Rows.Count).End(xlUp).Row)
Range("K1") = "Count_PTD"
Dim iRng as Range
For each iRng in paste_conPTD
iRng.Offset(0,1) = Worksheetfunction.Countif(paste_conPTD, iRng)
Next iRng
To give you some notes, we need to iterate over each cells in the paste_conYTD range, that is where iRng comes in. We can't tell Excel like paste_conYTD = <some formula> and assume Excel knows we want it to compute for each cells using the formula. Excel iteration comes in a few ways, we can choose one that is easiest to apply based on scenario.
For each ... in ... Next
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/for-eachnext-statement
For ... Next
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/fornext-statement
Do... Loop
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/doloop-statement
While... Wend
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/whilewend-statement
If you want the actual formula in the cells try this.
Dim paste_conPTD As Range
Set paste_conYTD = Range("J2:J" & Range("A" & Rows.Count).End(xlUp).Row)
Range("K1").Value = "Count_PTD"
paste_conYTD.Offset(, 1).FormulaR1C1 = "=COUNTIF(" & paste_conYTD.Address(ReferenceStyle:=xlR1C1) & ",RC[-2])"

Sumproduct in macro

I am trying to make a macro using the SUMPRODUCT function together with SUMIF.
but when I run the macro I get …
run-time error 13.
I have tryed to make the same function just in a cell looking like this.
=SUMPRODUCT(SUMIF(B2:B3,K15:K18,L15:L18))
and it works fine, so I know the concept is proven.
Sub GrandTotal() 'Finds the last non-blank cell in a single row or column
Dim lRow As Long
Dim lCol As Long
Dim GrandTotal As Variant
Dim MyRg1 As Variant
Dim MyRg2 As Variant
Dim MyRg3 As Variant
'Find the last non-blank cell in column A(1)
lRow = Cells(Rows.Count, 1).End(xlUp).Row
'Find the last non-blank cell in row 1
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
MsgBox "Last Row: " & lRow & vbNewLine & _
"Last Column: " & lCol
'set range
Set MyRg1 = Range("B2:B3")
'set criteria
Set MyRg2 = Range("$K$15:$K$18")
'set sum range
Set MyRg3 = Range("$L$15:$L$18")
For Each cell In Range(Cells(lRow, 2), Cells(lRow, lCol))
GrandTotal = WorksheetFunction.SumProduct(WorksheetFunction.SumIf(MyRg1, MyRg2, MyRg3))
cell.Value = GrandTotal
Next cell
End Sub
I have found some guides how to use the function in VBA and I followed the same princip, also i saw an other post here on stack that showed how to do, and yet I get the error.
hope some kind soul can help
First, each variable that is being assigned a Range object can be declared as a Range, instead of Variant. Also, the ranges that are being passed to SUMIF don't seem correct. The first argument or criteria range should be the same size as the third argument or sum range. So I am going to assume that the ranges assigned to MyRg1 and MyRg2 should be the other way around. So to start with we should have the following...
Dim MyRg1 As Range
Dim MyRg2 As Range
Dim MyRg3 As Range
'set criteria range
Set MyRg1 = Range("$K$15:$K$18")
'set criteria
Set MyRg2 = Range("B2:B3")
'set sum range
Set MyRg3 = Range("$L$15:$L$18")
Secondly, you won't be able to use WorksheetFunction.Sumproduct that way. You can, however, use the Evaluate method..
GrandTotal = Evaluate("SUMPRODUCT(SUMIF(" & MyRg1.Address & "," & MyRg2.Address & "," & MyRg3.Address & "))")
Note, though, the Evaluate method has a limitation. It does not accept more than 255 characters. In any case, since you want to transfer the result to a cell, you can first enter the actual formula in the cell, and then convert it into a value...
With cell
'enter the formula in the current cell
.Formula = "=SUMPRODUCT(SUMIF(" & MyRg1.Address & "," & MyRg2.Address & "," & MyRg3.Address & "))"
'convert the formula into a value
.Value = .Value
End With
Hope this helps!
After you have your function working, you can turn on the Macro Recorder, click the cell with the function you need, hit F2, and hit Enter. You will have VBA that does what you want.
Error 13 is a Type mismatch error. I looked up the documentation of WorksheetFunction.SumIf. It says the first argument should be of type Range, and the second and third a Variant. I can not test now, but try to declare MyRg1 as a Range.
This would be a good use for ConvertFormula since you have successfully built the formula in Excel, you just need VBA to generate the value. Note that convertformula cannot handle formulas over 255 characters.
Here's roughly how you could apply it. It's
Sub heresExample()
'formula with the cell in exitance
Dim fCell As Range
Set fCell = Range("G10") 'set this up with a formula that works for
'if you were to copy paste formula.
'Your original code modified
Dim cell As Range
For Each cell In Range(Cells(lRow, 2), Cells(lRow, lCol)).Cells
'Takes the formula and applies the value if from that exact cell.
'(you don't really need grand total)
GrandTotal = Evaluate(Application.ConvertFormula(fCell.Formula2R1C1, xlR1C1, xlA1, , cell))
cell.Value = GrandTotal
Next cell
End Sub

How to make a sheet scroll to the last row with data once a button is clicked

I have looked through the forum, as well as Google, and I wasn't able to find an answer to what I'm trying to do.
One of the users [here][1] helped me get a code to copy data in a specific row (upon clicking a button) to the last row of a table that is found further down in the same sheet.
However, I'd like the sheet to scroll down to the last non-empty row of the table instead of scrolling manually. I understand that this can be accomplished through a combination of CTRL+SHIFT+"DOWN ARROW". However; the excel users are not very good with computers, so I am trying to make it as simple as possible to them.
Is there a VBA code that can do the job?
Thanks
So far, I am using Erin's code, which takes me to the last row of the spread sheet, instead of the last Non-Blank row. This could be because column A has formulas in all its cells, all the way down to the last cell. However, column A cells formulas are set to give blank unless there's data entered in their adjacent cells in column E.
Here's the code that I am using, which is pasted in the module.
Option Explicit
Sub copyRow()
Dim ws As Worksheet
Dim lRow As Long
' define which worksheet to work on, i.e. replace Sheet1 with the name of
your sheet
Set ws = ActiveWorkbook.Sheets("1. Clients Details")
' determine the last row with content in column E and add one
lRow = ws.Cells(Rows.count, "E").End(xlUp).Row + 1
' copy some cells into their ranges
ws.Range("E3:G3").Copy ws.Range("E" & lRow)
ws.[E1].Select
' combine H3, I3, J3, K3 and L3 and copy into column E, next empty row
ws.Range("H" & lRow) = ws.[H3] & " " & ws.[I3] & " " & ws.[J3] & ", " & ws.
[K3] & " " & ws.[L3]
' copy the other cells into their ranges
ws.Range("M3:Q3").Copy ws.Range("M" & lRow)
ws.[M1].Select
' combine H3 & I3
ws.Range("AA" & lRow) = ws.[H3] & " " & ws.[I3]
' combine J3, K3 & L3
ws.Range("AB" & lRow) = ws.[J3] & " " & ws.[K3] & " " & ws.[L3]
' copy Q3 into column Q only, if F3 = "Company"
If Worksheets("1. Clients Details").Range("F3").Value = "Company" Then
ws.Range("Q3").Copy ws.Range("Q" & lRow)
End If
Call scrollToEnd
End Sub
Sub scrollToEnd()
Dim lastrow As Long
Dim numRows As Long
numRows = Range("E1:E1000").Rows.count
lastrow = Range("E1:E1000").Columns(5).Rows(numRows).Row
ActiveSheet.Range("E" & lastrow).Activate
End Sub
Dim lastrow as long
Dim numRows as long
numRows = Range ("TableName").Rows.Count
lastRow = Range ("TableName").Columns (1).Rows(numRows).Row
Activesheet.Range("A" & lastRow).Activate
I can't test it right now, but I believe this will work. If you know the offset for your table, you can just do numRows + offset (mine are usually in A1, so I just add 1 for the header - numRows is data rows) to get your row number for the .Activate. :-)
Or to reach the same row as CTRL+SHIFT+"DOWN ARROW", regardless of the table:
With Activesheet
.Range("A" & .UsedRange.Rows(.UsedRange.Rows.Count).Row).Activate
End With
EDITED: I was thinking CTRL+END in the above code. To simulate CTRL+"DOWN ARROW" (adding SHIFT selects everything in its path...), you would actually use:
Range("A1").End(xlDown).Activate
You could simply paste this at the end of your sub since it is one line, or keep it as its own little sub if you are wanting to call it from a button-click. If it is column E that you want selected, you would simply replace "A1" with "E1".
This does assume that there are no blank cells in column E between "E1" and the last non-blank row. Otherwise, you will need to use the same logic as in your copyRow sub to find the last non-blank row:
ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Activate
This will scroll down till the last row's cell is at the top left of the screen.
Sub test()
Application.Goto Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp), True 'where 'A' is the column of the last row
End Sub
You can paste the code at the bottom of your current procedure or assign it to a button.
EDIT:
Alternatively, you can try this. This will find the last row of any column.
Sub test()
Dim lastrow As Range
Set lastrow = Sheets("Sheet1").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious)
If Not lastrow Is Nothing Then Application.Goto lastrow, True
End Sub

Find a value and .filldown over multiple subsequent ranges?

VBA newbie here. I have a dynamic list of multiple groups. Each group lists the leader of the group at the top with the members of the group below. There is a primary key in Column A next to each listed person. I want to take the leader's key # and apply it to Column F for the leader and each member of the group, such that each member has their own primary key # in Column A and is associated with their leader's primary key # in Column F. Here are two images of what I need for the before and after:
Before
After
Here is the code I am playing around with conceptually:
Sub Apply_Leader_Code()
Dim wSht As Worksheet
Dim lStart As Long, lEnd As Long, lLdrID As Long
Set wSht = ThisWorkbook.Sheets("Upload")
With wSht.Range("A1:G" & Range("A" & Rows.Count).End(xlUp).Row)
lStart = .Rows.Find("78") 'Find the first row for each group
lEnd = .Rows.FindNext("78") - 1 'Find the last row for each group
If .Range("G" & lStart & ":G" & lEnd).Value = "" Then
'If there is no leader ID yet, then continue...
lLdrID = .Cells(lStart, 1).Value 'Assign leader's primary key to the variable
.Cells(lStart, 7).Value = lLdrID 'Place lLdrID value into Column G
.Range("F" & lStart & ":F" & lEnd).FillDown 'Fill value to end of group range
Else
'..otherwise, set start/end rows for next group.
lStart = .Rows.FindNext("Leader")
lEnd = .Rows.FindNext("Leader") - 1
End If
End With
End Sub
The above code isn't actually applicable, but I hope represents what I think is a reasonable way to solve this problem. I can (maybe?) figure out how to do this for the first group, but how do I then perform the same .FillDown function for each subsequent group?
--EDIT--
In regards to Siddarth Rout's answer below, here is my newer code:
Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-6]"
Range("G3").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=78,RC[-6],R[-1]C)"
Range("G3").Select
Selection.AutoFill Destination:=Range("G3:G" & Range("G" & Rows.Count).End(xlUp).Row)
I used the Macro creator in Excel and then edited it to what I thought would enable it to have a dynamic range instead of a set range. Now I'm getting a 400 error. Any ideas why? Any ideas on how to input the formulas w/o "selecting" the range? I am gathering that many programmers think that selecting cells is bad programming...
Do you need VBA for this? This can be achieved using excel formulas
Formula in Cell G2
=A2
Formula in Cell G3
=IF(F3=78,A3,G2)
now simply copy the formula from G3 down to G14
If you still need VBA then simply record a macro for the above steps and amend it :)
FOLLOWUP (From Comments)
Yes .Select should be avoided.
INTERESTING READ
Also no need to use R1C1 format. You can directly specify the formula
And one more thing. You don't need to use Autofill. You can skip that step by directly filling all the relevant cells with the relevant formula in ONE GO
Is this what you are trying?
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Find the last cell in Col A which has data
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Enter first formula
.Range("G2").Formula = "=A2"
'~~> Enter 2nd formula in all the
'~~> cells in one go rather than autofill
.Range("G3:G" & lRow).Formula = "=IF(F3=78,A3,G2)"
End With
End Sub

How to concatenate text from a column into a new column? VBA Excel

I'm new to vba programming and I would like to work on a function to fix salutations in an excel file.
To start, I would just like to append a Dear " to a name in the first column, and put this value in the next column, so that I would end up with the name in the first column and "Dear name" in the next column.
The function I have so far, is putting "Dear " in the next column, but it is not appending that to the text in the first column. Could someone help me correct my code?
Sub letterSalutationFixer()
Dim letterSalutationColumn As Range
Set letterSalutationColumn = Columns(1)
For Each Cell In letterSalutationColumn
Cell.Offset(, 1).Value = "Dear " & Cell.Text
Next
End Sub
PS. I do realise that I don't necessarily need to do this programmatically since it doesn't take that long to do with the functions already available, but I eventually want to expand this to fix other data with more complexity - and just thought I could start with something simple.
Many thanks in advance!
The reason it's blank is that Cell is equivalent to the whole column. You're close though. If you did...
For Each Cell In letterSalutationColumn.Cells
..l it would cycle through each cell.
However, the way it's written, it would cycle through each cell in the whole column, which could crash Excel, or at least slow things way down.
Here's a reworked version of what you're trying to do. It only acts on the cells in column A with content:
Sub Salutation()
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim NameRange As Excel.Range
Dim cell As Excel.Range
Set ws = ActiveSheet
With ws
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set NameRange = .Range("A2:A" & LastRow)
For Each cell In NameRange
cell.Offset(, 1) = "Dear " & cell.Text
Next cell
End With
End Sub
It also declares all variables, something you want to get in the habit of doing. Do a search on Option Explicit to learn how to force yourself to.
It also uses a With statement to fully qualify Object references, so that instead of just referring to Column(1) or Range(something) you're specifying that it's in ws, which has been set to the ActiveSheet.
Another way is the VBA alternative of
Using a formula in column B that runs the concatenation against the used part of column A (ie in B1 ="Dear " &A1 etc)
The formula then is copied over itself as a value to remove the formula
code
Sub QuickCon()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
With rng1.Offset(0, 1)
.FormulaR1C1 = "=""Dear "" &RC[-1]"
.Value = .Value
End With
End Sub

Resources