Long story short, I need pull a first name and last name into one string of text in VBA. This is a part of an automated report so I need it to loop until the next cell is empty.
I can for some reason split a full name into separate text, but combining the two cells is not working for me.
Dim first As Variant, last As Variant, full As string
With Worksheets("RG0054_Term Validation")
.Columns("D").Insert
.Range("D10").Value = "Employee Name"
Set first = .Range("B11")
Set last = .Range("C11")
full = 0
Do Until IsEmpty(first.Value)
Do Until IsEmpty(last.Value)
ActiveCell.Offset(0, full).Formula = first.Value & " " & last.Value
full = full + 1
Set last = last.Offset(0, 1)
Loop
Set last = .Range("C11")
Set title = title.Offset(1, 0)
Loop
End With
End Sub
turn b11 & c11 = d11 for i to 3000
I am guessing I could do a loop first = i to 3000 and last = 1 to 2 .. but I am not sure how to organize this... Also an explanation of the script logic would be great so I can learn the code syntax rather than regurgitate it.
No need for a loop. The simplest way would be to find the last row in Col B and then enter the formula in Col D in one go. For example
With Worksheets("RG0054_Term Validation")
Lrow = .Range("B" & .Rows.Count).End(xlUp).Row
.Columns(4).Insert
.Range("D10").Value = "Employee Name"
.Range("D11:D" & Lrow).Formula = "=B11 & "" "" & C11"
End With
Related
I am trying to copy and paste the entire entire columns values from sheet named Hey, to another columns in a sheet named final.
I dont want to use copy, paste or select option.However, my code is copying only the 1st line.
IntLastRow = Sheets("Hey").Cells(Cells.Rows.Count, "A").End(xlUp).Row
' IntRLastRow = Sheets("Interdiction Review").Cells(Cells.Rows.Count, "A").End(xlUp).Row
If Sheets("Hey").Range("H2") = "" Then
Sheets("Final").Range("A2").Value = Sheets("Hey").Range("G2:G" & IntLastRow).Value
ElseIf Sheets("Hey").Range("H2") <> "" Then
Sheets("Final").Range("A2").Value = Sheets("Hey").Range("H2:H" & IntLastRow).Value
EndIf
maybe do you know what I am doing wrong?
I need to copy dates from 2 or more columns to another column located in a different worksheet.
However, I am not sure if I can use 2 last row in the same line.
I am trying this code, but only paste the value of 1 line.
intrlastrow = Sheets("Final").Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
Debug.Print intrlastrow
If Sheets("Hey").Range("AJ2") = "" Then
Sheets("Final").Range("A" & intrlastrow, "A" & IntLastRow).Value = Sheets("Hey").Range("AI2:AI" & IntLastRow).Value
ElseIf Sheets("Hey").Range("AJ2") <> "" Then
Sheets("Final").Range("A" & intrlastrow, "A" & IntLastRow).Value = Sheets("Hey").Range("AJ2:AJ" & IntLastRow).Value
End If
I need to add the values of 2 or more columns from sheet named HEY to the same column in the destination sheet (Final sheet)
Unless the range you are trying insert the values from is as large as the one you are taking them from, only the data which fits will be copied. Changing your code to something like
Option Explicit
Sub test()
Dim IntLastRow As Long
IntLastRow = Sheets("Hey").Cells(Cells.Rows.Count, "A").End(xlUp).Row
' IntRLastRow = Sheets("Interdiction Review").Cells(Cells.Rows.Count, "A").End(xlUp).Row
If Sheets("Hey").Range("H2") = "" Then
Sheets("Final").Range("A2:A" & IntLastRow).Value = Sheets("Hey").Range("G2:G" & IntLastRow).Value
ElseIf Sheets("Hey").Range("H2") <> "" Then
Sheets("Final").Range("A2:A" & IntLastRow).Value = Sheets("Hey").Range("H2:H" & IntLastRow).Value
End If
End Sub
should do the trick.
You probably notice that I've changed Sheets("Final").Range("A2") to Sheets("Final").Range("A2:A" & IntLastRow), similar to what you've done to decide what range to copy values from.
My situation is as follows. I have a list of around 2k student accounts and sort the information to a specific format that i can format to our new CRM. The way the data is presented initially makes that problematic.
As you can see on the first screenshot, every student's university choice is presented in a separate row. So if a student has chosen more than one university, data about it is stored in 2-6 rows (each student can select 1 to 6 universities) repeating his personalID, name, forename and DoB every line.
What I need to achieve is to remove repeating information and store all data about each student in one row per student(example on screenshot 2).
I have no idea how to achieve this using VBA. I was trying with IFs, loops and arrays but without any progress. I need help on how to accomplish that using VBA.
Please let me know if you need more information. I will try to explain it in more details if required.
Screenshot 1
Screenshot 2
EDIT: This is the part of the report. I am working on a macro that will format it to our needs and will give us more info about the student's accounts. That is why I am asking for help in VBA.
No need to use VBA for this. Power Query will help you better. Have a look here: https://excelgorilla.com/power-bi/power-query/aggregate-text-values-using-group-by/
This seems to work. I'm new to VBA and programming in general so it's possibly not the most efficient solution and can definitely be improved.
Instead of working with a blank sheet, it transforms the current data to the format you wanted. You can add field headings where you want.
Edit: It assumes that each Student has 5 universities in the list. The code can be adjusted to account for any number by just adjusting the target range dynamically.
Edit 2: I added the change to account for students who've entered any number of universities between 1 to 5. Let me know if this gets it done!
Sub ReArrange_Data()
Dim lrow As Long
lrow = Cells(Rows.Count, 1).End(xlUp).Row
Dim First As Integer
Dim Last As Integer
Dim test As Integer
Dim test1 As Integer
Dim student_range As Range
Dim student_rows As Integer
Dim target_range As Range
First = 2
For i = 2 To lrow
Last = First
If Cells(First, "D").Value = "" Then GoTo Break 'reached end of data
While Cells(Last, "D").Value = Cells(Last + 1, "D").Value
Last = Last + 1
Wend
If Last <> First Then 'check if mulitiple uni and build range
Set student_range = Range("E" & First & ":" & "E" & Last)
student_rows = student_range.Rows.Count
If student_rows = 5 Then
Set target_range = Range("E" & First & ":" & "I" & First)
ElseIf student_rows = 4 Then
Set target_range = Range("E" & First & ":" & "H" & First)
ElseIf student_rows = 3 Then
Set target_range = Range("E" & First & ":" & "G" & First)
ElseIf student_rows = 2 Then
Set target_range = Range("E" & First & ":" & "F" & First)
End If
Else
GoTo Skip 'student entered one uni, go to next loop
End If
target_range = Application.WorksheetFunction.Transpose(student_range.Value) 'row to column
Rows(First + 1 & ":" & Last).EntireRow.Delete
Skip: 'delete repeated entries
First = First + 1
Next i
Break:
End Sub
I have written a code in VBA where a V-Lookup is done if a certain condition is met.
It works fine but now how can I do the same thing to the next row data values without the need to rewrite the code.
Sub starting_stock()
If Worksheets("out").Range("E2").Value = "" Then
Set ItemRef = Worksheets("out").Range("A2")
Set MyRange = Worksheets("Inventory").Range("A:G")
Worksheets("out").Range("D2").Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 7, False)
End If
End Sub
I want to do the same to D3 with values of E3, A3 without the need to rewrite the code every time.
This is an Stock Control System.
There are two sheets, One is called "Inventory" and the other is called "out".
Field in Inventory : ProductRef,Initial Stock, Stock Out(SUMIF for all Qty Out corresponding to a particular ProductRef), Final Stock.
Field in out : Product Ref, Starting Stock, Qty out, Remaining Stock, Date.
The aim here is to V-lookup the Final Stock from Inventory into Starting Stock if Qty Out is Null and as per the V-Lookup criteria of product Ref.
Remaining Out has a simple formula Starting Stock- Qty Out.
A normal formula cannot be used since any changes made in Qty will affect all previous entries with the same Product Ref.
Starting Stock should be as at date and remain as such.
All you need to do is wrap it in a For loop. See below:
Option Explicit
Sub starting_stock()
Dim i As Long
For i = 2 To 3
If Worksheets("out").Range("E" & i).Value = "" Then
Set ItemRef = Worksheets("out").Range("A" & i)
Set MyRange = Worksheets("Inventory").Range("A:G")
Worksheets("out").Range("D" & i).Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 7, False)
End If
Next i
End Sub
Read more about For loops here: https://excelmacromastery.com/vba-for-loop/
I assume this is what you are looking for:
You want to select a cell in a column and run the code and it will use value of the A column on the same row to perform the vlookup and paste the value in D column with the same row?
In that case ActiveCell.row is probably what you need.
Sub starting_stock()
If Worksheets("out").Range("E" & ActiveCell.Row).Value = "" Then
Set ItemRef = Worksheets("out").Range("A" & ActiveCell.Row)
Set MyRange = Worksheets("Inventory").Range("A:G")
Worksheets("out").Range("D" & ActiveCell.Row).Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 7, False)
End If
End Sub
I have found the following solution:
Sub Button_Click()
Dim i As Integer
i = 2
Do While Worksheets("out").Cells(i, 1).Value <> ""
If Worksheets("out").Range("E" & i).Value = "" Then
Set ItemRef = Worksheets("out").Range("A" & i)
Set MyRange = Worksheets("Current Inventory").Range("F:M")
Worksheets("out").Range("D" & i).Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 8, False)
End If
i = i + 1
Loop
End Sub
A while loop with the condition of not empty ProductRef.
I have 32.000 rows with data. Some data are in a different place and I want to join them with something that I can apply to all rows and not manually. Each "group" have the same ID, in this example is "XPTO"
I have something like this now (but with more columns):
I want it to be like this:
The problem is that I need a clever way, because they are not always exactly like this example. Some of them have 10 rows with the same ID "XPTO" (example)
I am struggling with this =/ ty
Here's how I would approach this.
1) From your comment, I understand that the logic is positional (the first one on the left (Casteloes de) goes with the first one on the right (R Dr Antonio) for the matching value in column A. If that is true, then I would insert a column where you start numbering sequentially, then Fill Down to get sequential numbers all the way to the end. This will help preserve the positional logic if you need to sort or rearrange your data. It will also help you with the logic of "first match", "second match", etc.
2) My next step would be to separate the two sets of data into separate tables/tabs (with the sequentially numbered column appearing in each) and use INDEX/MATCH. The recent answer here will help you with how to increment the match: Is there such thing as a VLOOKUP that recognises repeated numbers?
3) Alternative - this may even be easier, although you'll want to do extensive data checking to make sure nothing got screwed up. With the two tables from step 2, sort by any column with data in it, then delete the blank rows from each table. Then, sort each by the sequentially numbered column to return to the original order. At that point you may be able to just copy and paste. Check carefully for errors if you do this.
I am positive that the solution above given by CriketBird work, at least it has a good logic to solve it, but since I am a newbie in excel, I couldn't figure it out how to solve it that way.
So I solved it by using VBA in excel...(maybe I went too far for this simple problem, but it was my only option).
I will leave the code here if someone want it for a similar situation. (just select the first column and row your table starts and hit run)
Function Area(medico As String) As Integer
Do While countOk < 1
If medico = ActiveCell.Value Then
ActiveCell.Offset(1, 0).Select
rowCount = rowCount + 1
Else: countOk = 1
End If
Loop
Area = rowCount
End Function
Sub Teste()
Dim PaginaMedico As String
Dim totalrowCount As Integer
Dim rowCount As Integer
Dim countOk As Integer
Dim right As Integer
Dim left As Integer
Dim listaleft As New Collection
Dim listaright As New Collection
rowCount = 1
rowOk = 0
totalrowCount = 0
right = 0
left = 0
Do While ActiveCell.Value <> 0
PaginaMedico = ActiveCell.Value
rowCount = Area(PaginaMedico)
totalrowCount = totalrowCount + rowCount
Range("A" & (totalrowCount - (rowCount - 1))).Select
For i = ((totalrowCount + 1) - rowCount) To totalrowCount
If IsEmpty(Range("E" & (i)).Value) And IsEmpty(Range("F" & (i)).Value) Then
Range("T" & (i)).Value = "Empty"
ElseIf Not IsEmpty(Range("E" & (i)).Value) And Not IsEmpty(Range("F" & (i)).Value) Then
Range("T" & (i)).Value = "Full"
ElseIf Not IsEmpty(Range("E" & (i)).Value) And IsEmpty(Range("F" & (i)).Value) Then
left = left + 1
listaleft.Add i
ElseIf IsEmpty(Range("E" & (i)).Value) And Not IsEmpty(Range("F" & (i)).Value) Then
right = right + 1
listaright.Add i
End If
Next i
If Not (right = left) Then
Range("T" & totalrowCount).Value = "BOSTA"
right = 0
left = 0
End If
If listaleft.Count = listaright.Count Then
For i = 1 To listaleft.Count
Range("F" & listaright(1) & ":" & "S" & listaright(1)).Cut Range("F" & listaleft(1) & ":" & "S" & listaleft(1))
listaright.Remove (1)
listaleft.Remove (1)
Next i
End If
Set listaleft = New Collection
Set listaright = New Collection
Range("A" & (totalrowCount + 1)).Select
Loop
End Sub
I am fairly new to Excel Macros and I am looking for a way to loop through the row headings and columns headings and combine them into one cell for each row and column heading until I have combined all of them.
An example of the First Column cell would be "Your Organizations Title"
An Example of the First Row Cell Would be "22. Cheif Investment Officer"
An example of the first combined cell that I want on a new sheet would be this: "22. Chief Investment Officer (Your Organization's Title)
I then want the combined cells on the new sheet to offset one column to the right until it has iterated through all of the rows and columns.
I have just joined the forum and it will not let me post images or I would have. Perhaps this gives a better idea, here is my code now:
Sub Fill()
' Select cell A2, *first line of data*.
Set title = Sheets("Compensation, 3").Range("B6:B500")
Set descr = Sheets("Compensation, 3").Range("C5:AAA5")
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(title.Value)
Do Until IsEmpty(descr.Value)
ActiveCell.Offset(0, 1).Formula = _
"=title.value & "" ("" & descr.value & "")"""
Set descr = descr.Offset(0, 1)
Loop
Set title = title.Offset(1, 0)
Loop
End Sub
When I run it goes puts this into the active cell:
=title.value & " (" & descr.value & ")"
It does not recognize the variables and come up with the NAME error. It also goes into an infinite loop with no output besides the one cell.
Edit:
I cannot answer my own question because I am new to the forum, but using a combination of your answers I have solved the problem!
Here is the finished code:
Sub Fill()
' Select cell A2, *first line of data*.
Set title = Sheets("Compensation, 3").Range("B6")
Set descr = Sheets("Compensation, 3").Range("C5")
offsetCtr = 0
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(title.Value)
Do Until IsEmpty(descr.Value)
ActiveCell.Offset(0, offsetCtr).Formula = title.Value & " (" & descr.Value & ")"
offsetCtr = offsetCtr + 1
Set descr = descr.Offset(0, 1)
Loop
Set descr = Sheets("Compensation, 3").Range("C5")
Set title = title.Offset(1, 0)
Loop
End Sub
Thank you so much!
Option Explicit
Sub GenerateAndPasteFormulaForTitleAndDescription( _
ByVal titlesRange As Range, ByVal descriptionRange As Range, _
ByVal startCellOnDestination As Range)
Dim title As Range
Dim descr As Range
Dim offsetCtr As Long
Dim formulaTemplate As String
Dim newFormula As String
formulaTemplate = "=CONCATENATE([1], '(', [2], ')')"
startCellOnDestination.Worksheet.EnableCalculation = False
For Each title In titlesRange.Cells
For Each descr In descriptionRange.Cells
If title.Value <> "" And descr.Value <> "" Then
newFormula = Replace(formulaTemplate, "[1]", _
title.Address(External:=True))
newFormula = Replace(newFormula, "[2]", _
descr.Address(External:=True))
newFormula = Replace(newFormula, "'", Chr(34))
startCellOnDestination.Offset(0, offsetCtr).Formula = newFormula
offsetCtr = offsetCtr + 1
End If
Next
Next
startCellOnDestination.Worksheet.EnableCalculation = True
End Sub
Here is how to call the above procedure
GenerateAndPasteFormulaForTitleAndDescription _
Sheets("Compensation, 3").Range("B6:B500"), _
Sheets("Compensation, 3").Range("C5:AAA5"), _
Sheets("new sheet").Range("B5")
EDIT: The code loops through combination of title and description, checks if both of them aren't empty and creates a formula. It pastes the formula into the start cell (Sheets("new sheet").Range("B5") in this case) and moved ahead and pastes the next formula in the column next to it
Basically, you are trying to use VBA objects in worksheet functions. It doesn't quite work that way.
Try replacing
"=title.value & "" ("" & descr.value & "")"""
with
=title.value & " (" & descr.value & ")"