I have a table where the records contain multiple values separated by commas. I need to take each of these records and split them up based on the commas, with a new record for each value. I've attached an image from Excel to show what I mean.
I have a table where the records contain multiple values separated by commas. I need to take each of these records and split them up based on the commas, with a new record for each value. I've attached an image from Excel to show what I mean.
i dont think there is anyway to do it other than with recordsets and the split() function.
try that first.
As a one time effort, to normalize data, you would make a series of queries that separate the second column's data apart.
Depending on how well structured that data really is - you should be able to use string manipulation looking for commas to isolate each data component into its own column. - - and run them to append data into one table correctly.
I do this alot when importing non-normal excel spread sheets. But it is a one time, manual thing. Attempting to do this dynamically on the fly as a recurring feature is maybe feasible but more challenging.
Hope it helps.
I haven't finished this and it would have to be done in Excel but here is my start. This assumes in your picture, cell A2 is really A1. So basically get rid of your header. If this is in Access, I would run an export function, call Access to open a helper file with this macro in it and then open the exported file and run the macro.
If you run it you can see it runs a text to columns function then it adds rows where they are needed.Code:Sub rows2columns() ' ' rows2columns Macro ' ' Range("B1").Select FindLastRow = Range("A65536").End(xlUp).Row + 1 Range(Selection, Selection.End(xlDown)).Select Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _ True zMaxRows = Cells(Rows.Count, 1).End(xlUp).Row For x = zMaxRows To 1 Step -1 Range("B" & x).Select zMaxColumn = Cells(x, Columns.Count).End(xlToLeft).Column If zMaxColumn > 2 Then Rows(x + 1).Select For y = 1 To (zMaxColumn - 2) Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Next End If Next End Sub
The final steps would be to move columns B, C and D down and over then fill column A with the correct labels. (Yes its scaleable if you had even more entries in column B.)
You can then have the macro save the file and close it. Then you can use a transfertext command to import the file back in to Access. I'll work on it more tomorrow unless you think you have it from here.
Here is the entire code. Again is assumes you have no header and your data starts in A1 and B1.
Code:Sub rows2columns() ' 'Selects the data from column B Range("B1").Select Range(Selection, Selection.End(xlDown)).Select 'Runs a text to columns function to move items delimited by commas to other columns Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _ True zMaxRows = Cells(Rows.Count, 1).End(xlUp).Row 'Begins to step through each row starting at the end 'It starts at the end because when it adds rows the count wouldn't be correct if you had started from the top For x = zMaxRows To 1 Step -1 Range("B" & x).Select zMaxColumn = Cells(x, Columns.Count).End(xlToLeft).Column 'checks to see if there is more than one entry. If column B only had one entry there is no need to create a second row for that entry If zMaxColumn > 2 Then Rows(x + 1).Select Z = zMaxColumn - 1 For y = 1 To (zMaxColumn - 2) 'Enters a new row Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'Pastes the value from the end column to the new row Range("A" & x).Offset(0, Z).Copy Destination:=Range("B" & (x + 1)) 'Moves the end column counter back one Z = Z - 1 Next End If Next Columns("C:C").Select Range(Selection, Selection.End(xlToRight)).Select Selection.Delete Shift:=xlToLeft FindLastRow = Range("B65536").End(xlUp).Row Range("A1", "A" & FindLastRow).Select Selection.SpecialCells(xlCellTypeBlanks).Select Selection.FormulaR1C1 = "=R[-1]C" Range("A1", "A" & FindLastRow).Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("A1").Select End Sub