Printable View
Hi Rick,
I have attached the file for your review. The file was too large to attach so I stripped most of the data leaving enough for you to work with. Also I changed the delimiter to ", " using the replace all function, was hoping that would help but it did not.
The other part that I was not sure of was where to place the macro, in the worksheet or module either way I get an error. The attachment currently has it in the module.
Thanks for taking a look:-)
Hi Rick,
I just figured out the issue, some rows do not have data in the Delimited column which makes the code error. Anyway to tweek the code so it bypasses such rows?
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg. 9h5lFRmix1R9h78GftO_iE
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h77HSGDH4A
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h76fafzcEJ
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h759YIjlaG
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h74pjGcbEq
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgzJJUDVv2Mb6YGkPYh4AaABAg. 9h5uPRbWIZl9h7165DZdjg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
I'm trying to apply this macro to a spreadsheet that I have, but I'm having some issues. I keep getting a run time error. I've attached the file so that you can see what I'm working on.
Thanks for any help that you can lend!
Trosko, you are having the same issue that I faced, your deliminated column "L" has some blanks so the code errors out. I removed the rows with blanks in column L and the macro ran just fine.
So you'll need to update the macro to account for this. I wasn't able to figure that part out and in my case it didn't matter, rows with blanks in the deliminated column were not needed for my project so I was able to just delete those rows by inserting the following code in the macro. You'll notice I put the new code right after the delclarations and before the existing code.
Code:Sub RedistributeData()
Dim X As Long, LastRow As Long, A As Range, Table As Range, Data() As String
Const Delimiter As String = ", "
Const DelimitedColumn As String = "D"
Const TableColumns As String = "A:D"
Const StartRow As Long = 2
Columns(4).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
The modification worked great, but is there an easy to autofill the blanks with a value like "Null" rather than delete them?Quote:
Originally Posted by msrebraca
Things seem to go a little "wonky" when I hit 1179 rows - the macro still separates the rows, but it stops copying the information. Anyone have any idea why that might happen? Thanks!
You can select the range of cells in question and then use ctrl+F and the Replace All function to look for blanks and replace with NULL. Then run the original macro without the code that deletes the blanks.
Thanks! I knew there would be something really easy that I wasn't thinking of.Quote:
Originally Posted by msrebraca
Hi Rick,
Excellent code, I must say, but I found a problem if, for any reason, a customer has the column C blank.
Something like (Joe has no Parts)
Name Client Parts Rick 1111111 P1, P2, P3 Sam 2222222 P2, P5 Joe 3333333 Bill 4444444 P4, P6, P7, P8
This line of code throws an error
Code:Intersect (Rows (X + 1), Columns (TableColumns)). Resize (UBound (Data)). XlShiftDown Insert
The solution I found is (modifications in blue)
Code:Sub RedistributeDataV2()
Dim X As Long, LastRow As Long, A As Range, Table As Range, Data() As String
Const Delimiter As String = ", "
Const DelimitedColumn As String = "C"
Const TableColumns As String = "A:C"
Const StartRow As Long = 2
Application.ScreenUpdating = False
LastRow = Columns(TableColumns).Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
For X = LastRow To StartRow Step -1
Data = Split(Cells(X, DelimitedColumn), Delimiter)
If UBound(Data) And UBound(Data) <> -1 Then
Intersect(Rows(X + 1), Columns(TableColumns)).Resize(UBound(Data)).Insert xlShiftDown
Cells(X, DelimitedColumn).Resize(UBound(Data) + 1) = WorksheetFunction.Transpose(Data)
End If
Next
LastRow = Cells(Rows.Count, DelimitedColumn).End(xlUp).Row
On Error GoTo NoBlanks
Set Table = Intersect(Columns(TableColumns), Rows(StartRow) _
.Resize(LastRow - StartRow + 1, Columns(TableColumns).Columns.Count - 1))
On Error GoTo 0
For Each A In Table.SpecialCells(xlBlanks).Areas
A.FormulaR1C1 = "=R[-1]C"
A.Value = A.Value
Next
NoBlanks:
Application.ScreenUpdating = True
End Sub
This is reasonable or is there another more efficient solution?
Best Regards,
Marcelo
Thank you so much for pointing out this problem to me... I cannot believe it did not occur to me to test data where one or more of the cells are emptly.:duh: And thank you for your code suggestion as well; however, I decided to take a different route in fixing the problem. Your alert to me allowed me to review my code with "fresh eyes" and I saw a way to correct the problem while at the same time tighten up the code somewhat (I managed to eliminate the last For..Next loop entirely). I replaced the original code in Message #1 with my new code and put a note at the top indicating that message contains revised code (for those who previously visited this thread and then re-visit it in the future). Thank you again for pointing out the problem to me... I really appreciated it.Quote:
Originally Posted by Marcelo Branco