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
Related
I have a worksheet that contains 3 columns: name, city and education.
In column A (Names) I have duplicate values.
I want to separate it from other duplicate values in column A something like this shown in image below below.
Is it possible using VBA?
This code will add a blank row where Names is different. Assume Names in column A:
Sub SeparateDuplicates()
Dim lastCell As Integer
lastCell = Range("A" & Rows.Count).End(xlUp).Row
For i = lastCell To 2 Step -1
If Range("A" & i) <> Range("A" & i).Offset(-1, 0) Then
Range("A" & i & ":C" & i).Insert Shift:=xlDown
End If
Next i
End Sub
Excel has alredy has remove duplicates option on the ribbon. Data->RemoveDuplicates. You can also do this with advanced filters.
If you need to do it with VBA, for example:
Sub RemoveDuplicates()
ActiveSheet.Range("$A$1:$A$5").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
Where you need to put your range and your column.
A very useful tool to retrieve VBA code for determined action is the macro recorder, in the ribbon, Developer -> RecordMacro, perform you action and stop recording and then you can check the code generated for the actions you recorded. Its not the cleanest code but you can find there the lines of code for the specific actions you want.
Hope that helps
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])"
Semi-new to VBA but need help. I have the following code that I am trying to convert into a loop to provide the number of days between today's date and a date found in column A. The number of rows can change based on data entered and want it to stop when the cell in column A is blank. I also want only the value to appear. Any help is greatly appreciated. The below works great for the first row. I believe the loop should appear on row 2 but don't know how to go about it. Thank you in advance.
Range(ActiveSheet.Range("E2"), ActiveSheet.Range("E2").End(xlDown).Select
ActiveCell.FormulaR1C1 = "=SUM(TODAY()-OFFSET(R2C1,0,0,COUNTA(c[-4]),1))"
ActiveCell.Value = ActiveCell.Value
You do not need a loop for this. This will determine the used range in Column A and apply the formula (but only paste value) in the same used range down Column E
Also, notice that you do not need to use .Select, .Active, or .Selection. here. Directly qualify your ranges and you will save yourself trouble down the road. For learning purposes, it is best to act like those lines do not exist :)
Sub DateDif()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim LRow As Long: LRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
With ws.Range("E2:E" & LRow)
.Formula = "=NOW() - A2"
.Value = .Value 'If you want the formula to remain, remove this line
End With
End Sub
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
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