![]() |
Extract multiple data to other cells with same numbering
Hi,
I have the following problem : A=ID B 1 4 data more data even more data 2 5 data more data 3 6 data 4 7 data more data The first numbers are just the row numbering from Excel, the second number is an ID number I use , in colum B you will find the data about this ID number, but I want for data, more data and even more data that it is put in another row with the ID number in colum A, so i can create a tabel in acces with this in it, now it does not work because you have more objects in 1 cel So this schould be the result : A=ID B 1 4 data 2 4 more data 3 4 even more data 4 5 data 5 5 more data 6 6 data 7 7 data 8 7 more data How can I do this, so I can create a table in Acces Thanks |
Extract multiple data to other cells with same numbering
Ok, I think this is what you want. Please make a backup of your data before
running the code so you have something that is what you want in case the solution I am offering does NOT do what you want: Sub copyit() Dim LastRow As Long Dim myRange, MyRange1 As Range LastRow = Cells(Rows.count, "A").End(xlUp).Row For X = 1 To LastRow For Y = 1 + X To LastRow If Cells(X, 1).Value = Cells(Y, 1).Value Then If MyRange1 Is Nothing Then Set MyRange1 = Rows(Y).EntireRow Rows(X).End(xlToRight).Offset(, 1).Value = Cells(Y, 2).Value Else Set MyRange1 = Union(MyRange1, Rows(Y).EntireRow) Rows(X).End(xlToRight).Offset(, 1).Value = Cells(Y, 2).Value End If End If Next Next MyRange1.Select Selection.Delete End Sub -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "fasty100" wrote: Hi, I have the following problem : A=ID B 1 4 data more data even more data 2 5 data more data 3 6 data 4 7 data more data The first numbers are just the row numbering from Excel, the second number is an ID number I use , in colum B you will find the data about this ID number, but I want for data, more data and even more data that it is put in another row with the ID number in colum A, so i can create a tabel in acces with this in it, now it does not work because you have more objects in 1 cel So this schould be the result : A=ID B 1 4 data 2 4 more data 3 4 even more data 4 5 data 5 5 more data 6 6 data 7 7 data 8 7 more data How can I do this, so I can create a table in Acces Thanks |
Extract multiple data to other cells with same numbering
Give this macro a try...
Sub SplitDataLines() Dim X As Long, LastRow As Long, Data() As String Const FirstRow As Long = 1, DataCol As String = "B" LastRow = Cells(Rows.Count, DataCol).End(xlUp).Row For X = LastRow To FirstRow Step -1 With Cells(X, DataCol) Data = Split(.Value, vbLf) If UBound(Data) Then .Offset(1).Resize(UBound(Data)).EntireRow.Insert .Resize(UBound(Data) + 1).Value = WorksheetFunction.Transpose(Data) .Offset(, -1).Resize(UBound(Data) + 1).Value = .Offset(, -1).Value End If End With Next End Sub -- Rick (MVP - Excel) "fasty100" wrote in message ... Hi, I have the following problem : A=ID B 1 4 data more data even more data 2 5 data more data 3 6 data 4 7 data more data The first numbers are just the row numbering from Excel, the second number is an ID number I use , in colum B you will find the data about this ID number, but I want for data, more data and even more data that it is put in another row with the ID number in colum A, so i can create a tabel in acces with this in it, now it does not work because you have more objects in 1 cel So this schould be the result : A=ID B 1 4 data 2 4 more data 3 4 even more data 4 5 data 5 5 more data 6 6 data 7 7 data 8 7 more data How can I do this, so I can create a table in Acces Thanks |
Extract multiple data to other cells with same numbering
Rick, your macro didn't work for me, so I suspect my data-setup is wrong.
Fasty, maybe this is what you want: Sub copyit() Dim i As Long Dim LastRow As Long With Application ..ScreenUpdating = False ..Calculation = xlCalculationManual End With With ActiveSheet LastRow = .Cells(.Rows.count, "A").End(xlUp).Row For i = LastRow To 2 Step -1 If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then ..Cells(i, "C").Resize(, 100).Copy .Cells(i - 1, "D") ..Rows(i).Delete End If Next i ..Columns(2).Delete End With With Application ..Calculation = xlCalculationAutomatic ..ScreenUpdating = True End With End Sub -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "Rick Rothstein" wrote: Give this macro a try... Sub SplitDataLines() Dim X As Long, LastRow As Long, Data() As String Const FirstRow As Long = 1, DataCol As String = "B" LastRow = Cells(Rows.Count, DataCol).End(xlUp).Row For X = LastRow To FirstRow Step -1 With Cells(X, DataCol) Data = Split(.Value, vbLf) If UBound(Data) Then .Offset(1).Resize(UBound(Data)).EntireRow.Insert .Resize(UBound(Data) + 1).Value = WorksheetFunction.Transpose(Data) .Offset(, -1).Resize(UBound(Data) + 1).Value = .Offset(, -1).Value End If End With Next End Sub -- Rick (MVP - Excel) "fasty100" wrote in message ... Hi, I have the following problem : A=ID B 1 4 data more data even more data 2 5 data more data 3 6 data 4 7 data more data The first numbers are just the row numbering from Excel, the second number is an ID number I use , in colum B you will find the data about this ID number, but I want for data, more data and even more data that it is put in another row with the ID number in colum A, so i can create a tabel in acces with this in it, now it does not work because you have more objects in 1 cel So this schould be the result : A=ID B 1 4 data 2 4 more data 3 4 even more data 4 5 data 5 5 more data 6 6 data 7 7 data 8 7 more data How can I do this, so I can create a table in Acces Thanks . |
Extract multiple data to other cells with same numbering
I assumed the multiple lines shown for each ID were in the same cell
separated by Line Feed characters (rather than each line being on its own row). -- Rick (MVP - Excel) "ryguy7272" wrote in message ... Rick, your macro didn't work for me, so I suspect my data-setup is wrong. Fasty, maybe this is what you want: Sub copyit() Dim i As Long Dim LastRow As Long With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With With ActiveSheet LastRow = .Cells(.Rows.count, "A").End(xlUp).Row For i = LastRow To 2 Step -1 If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then .Cells(i, "C").Resize(, 100).Copy .Cells(i - 1, "D") .Rows(i).Delete End If Next i .Columns(2).Delete End With With Application .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "Rick Rothstein" wrote: Give this macro a try... Sub SplitDataLines() Dim X As Long, LastRow As Long, Data() As String Const FirstRow As Long = 1, DataCol As String = "B" LastRow = Cells(Rows.Count, DataCol).End(xlUp).Row For X = LastRow To FirstRow Step -1 With Cells(X, DataCol) Data = Split(.Value, vbLf) If UBound(Data) Then .Offset(1).Resize(UBound(Data)).EntireRow.Insert .Resize(UBound(Data) + 1).Value = WorksheetFunction.Transpose(Data) .Offset(, -1).Resize(UBound(Data) + 1).Value = .Offset(, -1).Value End If End With Next End Sub -- Rick (MVP - Excel) "fasty100" wrote in message ... Hi, I have the following problem : A=ID B 1 4 data more data even more data 2 5 data more data 3 6 data 4 7 data more data The first numbers are just the row numbering from Excel, the second number is an ID number I use , in colum B you will find the data about this ID number, but I want for data, more data and even more data that it is put in another row with the ID number in colum A, so i can create a tabel in acces with this in it, now it does not work because you have more objects in 1 cel So this schould be the result : A=ID B 1 4 data 2 4 more data 3 4 even more data 4 5 data 5 5 more data 6 6 data 7 7 data 8 7 more data How can I do this, so I can create a table in Acces Thanks . |
All times are GMT +1. The time now is 10:23 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com