Hello I'd like to know if I could somehow take single text word from a column and make them a single cell in a row. This is hard to describe but hopefully I can provide a screenshot.
So the "Contents" word should be cut out and everything after that should be in their own cells with the id tagged next to the cell. The wordcount in one column can differ from 1 to 100. Same with the ID count.
Thanks in advance!
The following code should achieve the goal you give:
Private Sub SortAndSplit()
Dim docId, docContent, lastRow, docArray, myLoop, myArrayLoop, lastRowList
Dim wSheet: Set wSheet = ThisWorkbook.Worksheets("Sheet1")
lastRow = wSheet.Cells(wSheet.Rows.Count, 2).End(xlUp).Row ' Get last row in column 2 (B)
For myLoop = 2 To lastRow
docId = wSheet.Range("A" & myLoop).Value
docContent = wSheet.Range("B" & myLoop).Value
docArray = Split(Trim(Replace(docContent, "Contents ", "")), ",")
For myArrayLoop = 0 To UBound(docArray)
lastRowList = wSheet.Cells(wSheet.Rows.Count, 4).End(xlUp).Row + 1 ' Get last row in column 4 (D) and add 1
wSheet.Range("D" & lastRowList).Value = docId
wSheet.Range("E" & lastRowList).Value = docArray(myArrayLoop)
Next
Next
End Sub
Related
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
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
currently I am working with an Excel report that has 135.000 rows. There are assets listed in it and I want to count each asset and write it into another worksheet.
I have tried to write a VBA script, which you can find below. It just copies one entry but does not iterate over each row of the worksheet.
Sub assetVulnerabilityCount()
With Sheets("tblExport")
assetCount = 1
rowMax = Sheets("tblExport").Cells(.Rows.Count, "F").End(xlUp).row
currentAsset = Sheets("tblExport").Range("B" & row).Value
For row = 2 To rowMax
If currentAsset = Sheets("tblExport").Range("B" & row).Value Then
Sheets("tblTarget").Range("B" & assetCount).Value = Sheets("tblTarget").Range("B" & assetCount).Value + 1
Sheets("tblTarget").Range("A" & assetCount).Value = currentAsset
Else:
currentAsset = Sheets("tblExport").Range("B" & row).Value
assetCount = assetCount + 1
End If
Next Zeile
End With
End Sub
Ideally, it would look like this:
Worksheet1:
Asset Names:
Laptop1337
Laptop1337
Laptop1337
PC420
PC420
Worksheet2:
Asset Name: Amount:
Laptop1337 3
PC420 2
Worksheet1 is what I have and Worksheet2 is what I need.
If we assume rowMax has the number of rows you need to iterate then
For row = 2 To rowMax
Should loop the rows if
Next Zeile
Is replaced with
Next row
Since it's row that is the variable in the loop.
this is my first time using the site, so forgive me for any inept explaining. I have a working macro to hide/unhide rows based on content of the rows, I just want it to be faster. Using a check box, when the box is checked, all rows with an "x" in column D get unhidden, those without an "x" get hidden. Same thing happens when it is unchecked, except it references column C, not D.
Right now, this code works. It's just a little slower than I'd like, since I'm sharing this with a bunch of people. Any ideas for how to speed it up? I'm pretty darn new to VB (the internet is astoundingly wise and a good teacher), but that doesn't matter. I already improved the code - before it selected each row, then referenced the column, and it was awful. Any ideas to speed it up (preferably without moving the screen) would be great.
Thanks so much folks,
DS
Sub NewLuxCheck()
Dim x As Integer
NumRows = Range("A42", "A398").Rows.Count
Range("A42").Select
If ActiveSheet.Shapes("checkbox2").OLEFormat.Object.Value = 1 Then
For x = 42 To NumRows + 41 Step 1
If Worksheets("Base").Range("D" & x).Value = "x" Then
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = False
Else
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = True
End If
Next
Else
For x = 42 To NumRows + 41 Step 1
If Worksheets("Base").Range("C" & x).Value = "x" Then
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = False
Else
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = True
End If
Next
End If
MsgBox ("Done")
End Sub
You could use array formula and let Excel to return array with row-numbers where 'x' value occures. It will be quicker but you'll have to reorganise your code and create separate functions etc.
Here example where array formula finds rows whre in column 'D' the cell has value 'x'. Then string of this row numbers is created in form of "A1,A5,A10" ...means 'x' was found in rows 1,5,10. And finally Range(rowsJoind).EntireRow.Hidden is used for all the rows to be hidden/un-hidden in one step.
For rows with value different then 'x' you'll have to use formula like '=IF({0}<>""x"", ROW({0}), -1)'.
Sub test()
Dim inputRange As Range
Dim lastRow As Long
Dim myFormula As String
Dim rowsJoined As String, i As Long
Dim result As Variant
With Worksheets("Base")
lastRow = .Range("D" & .Rows.Count).End(xlUp).Row
Set inputRange = .Columns("D").Resize(lastRow)
Application.ReferenceStyle = xlR1C1
myFormula = "=IF({0}=""x"", ROW({0}), -1)"
myFormula = VBA.Strings.Replace(myFormula, "{0}", inputRange.Address(ReferenceStyle:=xlR1C1))
result = Application.Evaluate(myFormula)
result = Application.Transpose(result)
Application.ReferenceStyle = xlA1
For i = LBound(result) To UBound(result)
If (result(i) > -1) Then
rowsJoined = rowsJoined & "A" & result(i) & IIf(i < UBound(result), ",", "")
End If
Next i
.Range(rowsJoined).EntireRow.Hidden = False
End With
End Sub
I have one excel Sheet having below records
id Empname state
1 steve NJ
2 karl NYC
I have to write one macro to prepare sql update stement like below and insert into new sheet within the same workbook.
UPDATE emp SET state='NJ' WHERE id=1
UPDATE emp SET state='NYC' WHERE id=2
Any suggestions or ideas please.
Regards,
Raju
Use below sub and you should be all set
Sub generateUpdate()
Dim myRow As Integer: myRow = 2 'Starting Row of data in source table
Dim temp As Integer: temp = 1
Do Until Sheet1.Cells(myRow, 1) = "" 'Loop until you find a blank
'Do Until myRow = 5 '5 is Row number till while you wish to loop
Sheet2.Cells(temp, 1) = "UPDATE emp SET state='" & Sheet1.Cells(myRow, 3) & "' where id = " & Sheet1.Cells(myRow, 1)
myRow = myRow + 1
temp = temp + 1
Loop
End Sub
You could do this with formulas; there's no need to write a macro (if I read your requirements correctly).
If your data is in Sheet1!A2:C3, then on Sheet2 you could start in cell A1 with the formula:
="UPDATE emp SET state = '" & Sheet1!C2 & "' WHERE id = " & Sheet1!A2
And then extend the formula down the column to repeat the pattern. After that you can simply copy the cells and paste the query into wherever you're going to use it.