I need help spliting a string separated by ";" and make a list as shown in this example:
| A |
|----------------------------|
| Row1 | Name1;Name2;Name3 |
| Row2 | Name1 |
| Row3 | Name2 |
| Row4 | Name3 |
How can I achieve this with a VBA function?
Thanks in advance,
MD
I like writing non-work-related code over lunch:
Sub NamesToList()
'Assumes that a cell is selected which contains a string which
'looks something like "Name1;Name2;Name3"
'The sub splits that list and then puts the values immediately
'below the selected cell. Warning: this doesn't check if there is
'room for those values and will overwrite existing values with no
'warning
Dim A As Variant, n As Long, R As Range
Set R = Selection
A = Split(R.Value, ";")
n = UBound(A)
Range(R.Offset(1), R.Offset(n + 1)).Value = Application.WorksheetFunction.Transpose(A)
End Sub
If you invoke this sub while A1 is selected, the names will be automatically inserted in A2:A4. No error-checking is done, so you should probably tweak this code to make sure that it doesn't e.g. overwrite any values.
Related
This was solved using a formula.
Unfortunately, I need a solution that works in Excel 2016, and it seems VBA is the best/only route.
Legend: (this is across multiple worksheets in the same workbook)
Each column has a header.
Column A of Sheet3: List of Names
Column H of Sheet3: List of Email Addresses
Column M of Sheet1: contains the below formula dragged down, which produces a variable number of rows of data:
=IFERROR(INDEX($A$2:$A$42,MATCH(0,IF("1"=$L$2:$L$42,COUNTIF($O$1:$O1,$A$2:$A$42),""),0)),"")
In column M of Sheet1, I have an Index/Match formula, which populates with a list of people's names. (As said above, the number of names that appear is ever-changing.)
I'd like to look up each name that appears in column M of Sheet1 against column A of Sheet3 then return the respective email address from column H of Sheet3.
Additionally, I'd like to separate each email address with a semicolon, as this is to populate the To field of an Outlook email.
Snapshot of what the data looks like
| A, Sheet3 | H, Sheet3 | M, Sheet1 |
| --------------- | ------------------------ | ------------- |
| John Smith | JohnSmith#email.com | Frank Sinatra |
| Kimberly Jones | Kimberly#email.com | Corey Smith |
| Joe Montana | JoeMontana#email.com | Kimberly Jones|
| Dean Martin | DeanMartin#email.com | John Smith |
| Corey Smith | Corey.Smith#email.com | |
| Frank Sinatra | Frank.Sinatra#email.com | |
In cell F2 of Sheet1, the macro would produce the below:
Frank.Sinatra#email.com; Corey.Smith#email.com; Kimberly#email.com; JohnSmith#email.com
Worksheet tab names:
Worksheet1:
Worksheet3:
Try,
Function JoinEmail() As String
Dim Ws(1 To 2) As Worksheet
Dim vDB As Variant, vR() As Variant
Dim vName As Variant
Dim Dic As Object 'Dictionary
Dim i As Long, n As Integer
Dim s As String
Set Ws(1) = Sheets(1)
Set Ws(2) = Sheets(3)
Set Dic = CreateObject("Scripting.Dictionary")
vDB = Ws(2).UsedRange 'Sheets(3) data
With Ws(1)
vName = .Range("M2", .Range("M" & Rows.Count).End(xlUp))
End With
For i = 2 To UBound(vDB, 1)
Dic.Add vDB(i, 1), vDB(i, 8) 'name, email
Next i
For i = 1 To UBound(vName, 1)
s = vName(i, 1)
If Dic.Exists(s) Then
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = Dic(s)
End If
Next i
If n Then
JoinEmail = Join(vR, "; ")
Else
JoinEmail = ""
End If
End Function
Sheet1 image
Sheet3 image
I have two problems:
I need to copy a table in .docx that has paragraph numbering in column A. The first row the of the table is a always merged(A-C). The table can be any number of rows but follows the same format.
.docx table Ex:
A B C
|'title...'|
|1.| T | F |
|2.| F | T |
|3.| T | T |
I know this code looks at (2, 1) but it does not return that table numbering '1.'. It just returns (2, 1) as a blank cell.
Ideally it would return the values of '1' (Without the period).
When I run the full code it passes through to 'Next iCol' the first time and then errors at 'Cells(resultRow, iCol)...' with: "The Requested member of the collection does not exist". I am thinking it has something to do with the first row being merged so Cell(1,2) does not exist but I am not sure of the solution.
CODE IN QUESTION:
ElseIf .Found = True Then
For iRow = 1 To wrdDoc.Tables(3).Rows.Count
For iCol = 1 To wrdDoc.Tables(3).Columns.Count
Cells(resultRow, iCol) = WorksheetFunction.Clean(wrdDoc.Tables(3).Cell(iRow, iCol).Range.Text)
Next iCol
resultRow = resultRow + 1
Next iRow
resultRow = resultRow + 1
End If
The final results in excel should match the .docx table without the column A period. If is easier the 'title' can just be placed in A1 with the rest of the table to follow.
A B C
|'title..'|
|1| T | F |
|2| F | T |
|3| T | T |
OR
A B C
|tle| | |
|1 | T | F |
|2 | F | T |
|3 | T | T |
Thank you for your help and time.
If the first cell in each row is formatted as "numbered list" then you can read the value like this:
Dim r As Long
With wrdDoc.Tables(3)
For r=2 to .Rows.Count
Debug.Print .Cell(r, 1).Range.ListFormat.ListValue
Next r
End with
Or use ListFormat.ListString if the list uses (eg) A, B, C, ...
Try something along the lines of:
Dim i as long
With wrdDoc.Tables(3).Range
For i = 1 To .Cells.Count
If .Cells(i).RowIndex > iRow Then resultRow = resultRow + 1
iRow = .Cells(i).RowIndex: iCol = .Cells(i).ColumnIndex
ActiveSheet.Cells(resultRow, iCol) = WorksheetFunction.Clean(.Cells(i).Range.Text)
Next
End With
Note the inclusion of a worksheet reference in the code - you may need to define that differently.
The code as posted works fine for me - The first output cell in Excel contains the first cell's text from the Word table. If that cell contains automatic numbering, though, the automatic number is not output. That is consistent with your own code.
The problem with trying to capture content that is included with automatic numbering is that such numbering is usually followed by a tab, which Excel will at best interpret as a column separator. For example:
wrdDoc.Tables(3).Range.Copy
xlWkSht.Cells(resultRow, 1).PasteSpecial xlPasteValues
resultRow = resultRow + wrdDoc.Tables(1).Range.Rows.Count
I have a table which has some string keys and numerical values like this-
-----------------
| Keys | Scores |
-----------------
| k1 | 10 |
| k2 | 15 |
| k3 | 8 |
-----------------
Now there's another table which has comma separated keys like this-
--------------------
| Keys | Total |
--------------------
| k1,k2 | |
| k3 | |
| k1,k2,k3 | |
--------------------
I want to fill the "Total" column by referencing the table. Is it possible in excel with formulas or VBScript?
This formula iterates the parts and uses SUMIFS to return the number to SUMPRODUCT:
=SUMPRODUCT(SUMIFS(B:B,A:A,TRIM(MID(SUBSTITUTE(E2,",",REPT(" ",999)),(ROW($ZZ$1:INDEX($ZZ:$ZZ,LEN(E2)-LEN(SUBSTITUTE(E2,",",""))+1))-1)*999+1,999))))
No vba or named range workarounds needed.
Here's one approach which uses the Evaluate method to create an array that consists of the criteria that will be passed to SUMPRODUCT(SUMIF(...)).
1) First, select cell F2.
2) Then, define the following name (Ribbon >> Formulas >> Defined Names >> Define Name)...
Name: MyArray
Refers to: =EVALUATE("{"""&SUBSTITUTE(SUBSTITUTE('Sheet1'!$E2," ",""),",",""",""")&"""}")
Click OK
Change the sheet name accordingly.
3) Then, enter the following formula in F2, and copy down:
=SUMPRODUCT(SUMIF($A$2:$A$4,MyArray,$B$2:$B$4))
You could use:
Code:
Option Explicit
Sub test()
Dim i As Long, y As Long, w As Long
Dim arrLookingValues As Variant, arrDataStored As Variant, arrValues As Variant
Dim Total As Long
With ThisWorkbook.Worksheets("Sheet1")
'Set an array which store Keys & Scores
arrDataStored = .Range("A2:B4")
'Set an array which store what we are looking for
arrLookingValues = .Range("D2:D4")
For i = LBound(arrLookingValues) To UBound(arrLookingValues)
Total = 0
'Set an array with the values of each row we are looking for
arrValues = Split(arrLookingValues(i, 1), ",")
'Loop the array which store the values we are looking for
For y = LBound(arrValues) To UBound(arrValues)
'Loop the array which store both Keys & Scores
For w = LBound(arrDataStored) To UBound(arrDataStored)
'If we find a match
If Trim(arrValues(y)) = arrDataStored(w, 1) Then
'Add Total
Total = Total + arrDataStored(w, 2)
Exit For
End If
Next w
Next y
'Print the result in column E
.Range("E" & i + 1).Value = Total
Next i
End With
End Sub
Results:
I have managed to get to a point with a data set where i have a list of items delimited with a "|" symbol. I am now trying to separate each item in the list into the corresponding column, however the identifier of the column is a bit of text at the end of each value of variable length.
Example Data (all in one column):
Column A
40.00A|24.00QS|8.00J[a]
40.00A|12.00J|8.00J[a]
20.00A|4.00V
30.00A|12.00CS|8.00QS
Desired Outcome:
+-------+-------+------+-------+-------+------+
| A | QS | J[a] | J | CS | V |
+-------+-------+------+-------+-------+------+
| 40.00 | 23.00 | 8.00 | | | |
| 40.00 | | 8.00 | 12.00 | | |
| 20.00 | | | | | 4.00 |
| 30.00 | 8.00 | | | 12.00 | |
+-------+-------+------+-------+-------+------+
The number of trailing characters that define columns is fixed to 6 (A,QS,J[a],J,CS & V), so I know at the beginning how many columns I will need.
I have some ideas on how to do it directly through formulas, but it would require me to split out the items into individual columns by the delimiter, then use some sort of if statement on some additional columns. Would prefer to avoid the helper column issue. Also, looked at the following link, but it doesn't solve the solution, as it assumes the value matches the column heading (I can correct that, but I feel like there is a faster VBA solution here):
How to split single column (with unequal values) to multiple columns sorted according to values from the original single column?
I have been reading about Regular Expressions, and i suspect there is a solution there, but I can't quite figure out how to sort the result.
Once i have this data setup, it is a small task to unpivot it and get the data in a proper tabular format using Power Query.
Thanks in advance!
since headers are fixed, it can simply be tried out like this (the Row & Column of the Source & destination data may be changed to your requirement)
Option Explicit
Sub test()
Dim Ws As Worksheet, SrcLastrow As Long, TrgRow As Long, Rw As Long
Dim Headers As Variant, xLine As Variant
Dim i As Long, j As Long
Set Ws = ThisWorkbook.ActiveSheet
'Column A assumed to have the texts
SrcLastrow = Ws.Range("A" & Rows.Count).End(xlUp).Row
TrgRow = 2
Headers = Array("A", "QS", "J[a]", "J", "CS", "V")
For Rw = 1 To SrcLastrow
xLine = Split(Ws.Cells(Rw, 1).Value, "|")
For i = 0 To UBound(xLine)
For j = 0 To UBound(Headers)
xLine(i) = Trim(xLine(i))
If Right(xLine(i), Len(Headers(j))) = Headers(j) Then
Ws.Range("D" & TrgRow).Offset(0, j).Value = Replace(xLine(i), Headers(j), "") ' The output data table was assumed to be at Column D
End If
Next j
Next i
TrgRow = TrgRow + 1
Next
End Sub
I have the following data in an excel worksheet, in columns A, B and C respectively.
+-----------+--------------+----------------+
| RangeName | Clear? | Value if Clear |
+-----------+--------------+----------------+
| Name1 | DO NOT CLEAR | |
| Name2 | | 6 |
| Name3 | | 7 |
| Name4 | DO NOT CLEAR | |
| Name5 | DO NOT CLEAR | |
| Name6 | DO NOT CLEAR | |
| Name7 | DO NOT CLEAR | |
| Name8 | DO NOT CLEAR | |
| Name9 | | 5 |
| Name10 | | 9 |
+-----------+--------------+----------------+
Theres a "clear" macro which checks for each excel range name, if column B says "DO NOT CLEAR" then it will skip and do nothing, if it is blank then it will clear the range name and set the range name value to column C. The code is as follows:
For i = 1 To MaxRowCount
Select Case Range("RngeTbl").Cells(i, 2).Value
Case "DO NOT CLEAR" 'do nothing
Case Else 'set to default value
Range(Range("RngeTbl").Cells(i, 1).Value).Value = Range("RngeTbl").Cells(i, 3).Value
End Select
Next i
However, the number of range names is increasing massively, and right now I have 32571 range names.
Is there a way I can speed this macro up? I've been trying put the column into an array and somehow check that way but I'm having no luck.
Any help please!
The following code should be slightly better (if run in the context of Application.ScreenUpdating = Fasle, etc.):
Dim A As Variant
Set A = Range("RngeTbl").Value
For i = 1 To UBound(A)
If A(i,2) <> "DO NOT CLEAR" Then Range(A(i,1)).Value = A(i,3)
Next i
If MaxRowCount is smaller than the number of rows in the range, then of course you could use that rather than UBound(A) in the loop.
This code will Sort your RngeTbl range on the "Clear?" column, then count how many non-Blank cells are in the "Clear?" column, and start the loop at the next row.
This will mean that the loop skips all of the "DO NOT CLEAR" ranges - if all ranges are to be cleared then the code will run slightly slower. If there are no ranges to be cleared then the code will only take about as long as the Sort does.
Dim lStart As Long
'Sort the range, without header
[RngeTbl].Sort [RngeTbl].Cells(1, 2), xlAscending, Header:=xlNo
'Since Calculation should be Manual for speed, we recalculate the sorted Range...
[RngeTbl].Calculate
'Count the Non-Blank cells in the "Clear?" column, to find the first non-blank cell
lStart = 1 + WorksheetFunction.CountA([RngTbl].Columns(2))
'If there ARE any non-blank cells
If lStart <= MaxRowCount Then
'Skip all of the "DO NOT CLEAR" cells
For i = lStart To MaxRowCount
Range(Range("RngeTbl").Cells(i, 1).Value).Value = Range("RngeTbl").Cells(i, 3).Value
Next i
Next lStart