VBA assistance to modify code

[tyantorno]

Hello All,

I have a piece of code that almost works for what I need it to do.
Basically, I have data consisting of a variable number of column separated
strings. example

01AL,02AL,03AL,04AL

When I run the code below

Sub CommaSeparated()

Dim curr_range As Range
Dim Row As Range
Dim arr As Variant
Dim cell As Variant
Dim output_str As String
Dim output_arr As Variant

Set curr_range = ActiveSheet.Range("A1:A9999")
For Each Row In curr_range
arr = Split(Row, ",")
For Each cell In arr
output_str = output_str & "," & cell

Next cell

Next Row
output_str = Replace(output_str, " ", "")
output_str = Right(output_str, Len(output_str) - 1)
output_arr = Split(output_str, ",")

ActiveSheet.Range("A:A").Value = Application.WorksheetFunction.Transpose(output_arr)

End Sub

It gives me sixteen rows of:

01AL
02AL
03AL
04AL
01AL
02AL
03AL
04AL
01AL
02AL
03AL
04AL
01AL
02AL
03AL
04AL

and a #VALUE down the rest of the column

I was hoping to only get four rows of:

01AL
02AL
03AL
04AL

with no #VALUE down rest of column.

Thank you in advance for any assistance/suggestions.

[stanleydgrom]

tyantorno,

Welcome to the VBA Express forum.

What version of Excel are you using?

It would help if you could attach a workbook with the raw data in a worksheet, and in another column or worksheet, the results you are looking for.

The structure and data types of the sample workbook must exactly duplicate the real workbook. Include a clear and explicit explanation of your requirements.

To attach your workbook, scroll down and click on the Go Advanced button, then scroll down and click on the Manage Attachments button.

Have a great day,
Stan

[tyantorno]

Hi Stan,

Thank you for the suggestion, I will upload the raw data and screenshots of what is happening when I run my code

Sub testx()
Dim awf As WorksheetFunction: Set awf = WorksheetFunction
Dim sCSString As String
Dim vArray
Dim i As Long
For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
sCSString = sCSString & "," & Range("B" & i)
Next i
sCSString = Right(sCSString, Len(sCSString) - 1)
sCSString = Replace(sCSString, " ", "")
sCSString = Replace(sCSString, ",,", ",")

vArray = Split(sCSString, ",")
Range("B1:B" & UBound(vArray) + 1) = _
awf.Transpose(vArray)
End Sub

And a second screenshot of what I would like to happen. Basically, It is creating 4 time 4 or sixteen rows for 4 string that are comma separated. I want just 4 rows of the four strings. Hope this helps, Thank you.

[stanleydgrom]

tyantorno,

There is no attached workbook.

Detach/open workbook ReorgData - tyantorno - VE280910 - SDG10.xls and run the ReorgData macro.


Have a great day,
Stan

[tyantorno]

Sorry, I don't think the site likes .rar. Trying again .zip. Thank you.

[stanleydgrom]

tyantorno,

Sorry, I do not accept ZIP files.

Have you opended my attached workbook, and did you run the macro?

Have a great day,
Stan

[stanleydgrom]

tyantorno,

With your raw data in worksheet Sheet1, beginning in cell A1.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.




Option Explicit
Sub ReorgData()
' stanleydgrom, 11/19/2012
' http://www.vbaexpress.com/forum/showthread.php?p=280910#post280910
Dim r As Long, lr As Long, s
Application.ScreenUpdating = False
Worksheets("Sheet1").Activate
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = lr To 1 Step -1
If InStr(Cells(r, 1), ",") > 0 Then
s = Split(Trim(Cells(r, 1)), ",")
Rows(r + 1).Resize(UBound(s)).Insert
Cells(r, 1).Resize(UBound(s) + 1).Value = Application.Transpose(s)
End If
Next r
Application.ScreenUpdating = True
End Sub




Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm


Then run the ReorgData macro.


Have a great day,
Stan

[tyantorno]

Thank you Stan,

That worked great. Have a Happy Thanksgiving! I am from PA originally as well, Eagles and Steelers are having alot of problems. Be safe

[stanleydgrom]

tyantorno,

Thanks for the feedback.

You are very welcome. Glad I could help.

Come back anytime.

And, you have a wonderful Thanksgiving.

Have a great day,
Stan