VBA assistance to modify code

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.


Moderator's Note: Please put code tags around codes, select the code then hit "#" sign. I'll do it for you, this time.

You need to resize the range you are putting the values in.

Try this.

ActiveSheet.Range("A:A").Resize(UBound(output_arr) + 1).Value = Application.WorksheetFunction.Transpose(output_arr)

Hello Norie,

That took care of the #VALUE, but still have sixteen rows of data with a new row inserted between each.
Thank you.

one way:

Dim awf As WorksheetFunction: Set awf = WorksheetFunction
Dim sCSString As String: sCSString = "01AL,02AL,03AL,04AL"
Dim sArray
sArray = Split(sCSString, ",")
'sArray = Split(Range("C1"), ",")
Range("A1:A" & UBound(sArray) + 1) = _
    awf.Transpose(sArray)

Regards, TMS

When I run the code I only end up with 4 rows of data.

That was with 01AL,02AL,03AL,04AL in A1, what data do you have exactly?

Originally Posted by Norie

When I run the code I only end up with 4 rows of data.

That was with 01AL,02AL,03AL,04AL in A1, what data do you have exactly?

Hello Norie,

I can have a variable number of comma separators and a variable of data e.g. 01AL,02AL or AK05,AK06 in column B. I am on 2007 Excel. Thank you.

I'm not entirely sure what you are saying. This code lists 12 cells:

Sub Test()
Dim awf As WorksheetFunction: Set awf = WorksheetFunction
Dim sCSString As String: sCSString = "01AL,02AL,03AL,04AL,01AL,02AL,03AL,04AL,01AL,02AL,03AL,04AL"
Dim sArray
sArray = Split(sCSString, ",")
'sArray = Split(Range("C1"), ",")
Range("A1:A" & UBound(sArray) + 1) = _
    awf.Transpose(sArray)

End Sub

the number of commas is irrelevant.

Regards, TMS

I realise you have multipe cells and multiple comma-separated values in the cells.

But what data do you have when the result is 16 rows of data with blanks inbetween?

Why don't we stop trying to second guess what your workbook, worksheet and data look like and you post a sample workbook with some typical data.

If you mock up what you want to see as output given specific input, I'm sure we can make it happen for you.

As it is, I'm losing interest ...

Regards, TMS

@MarvinP: I hadn't noticed a requirement to remove duplicates. But, if there is one, why do you need to sort the output?

Regards, TMS

Hi,

In his first post I found the result was filtered and sorted. I put filter and sort as separate subs so he could see them and the code for each sub function.

Hi,

Let me jump in here with an example of what I think you want and some code.

Here is how I'd do this problem. I took the column A and made what I think you want in Column B. I'd then delete column A to get exactly what I think you want.

Maybe this:

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

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

Regards, TMS

You have the same list of four values in 5 rows, do you want one of the rows deleted?

Marvin

First post?

Do you mean another thread?

Hi,

Run the macro with your name on it, with column J cleared of any data. I think this is what you want.

Marvin

That copies, sort and dedupes.

Just looked at the sample workbook. No way would I have guessed that the data looked like that, nor what was required.

All yours, guys.

TMS

@Marvin: are you confusing this thread with something else you're working on?

There's only an excerpt of code without Code tags, no workbook and a very limited explanation of the requirement.

The first workbook example was in post #15


Regards, TMS

Hey TM,

I wasn't confused. Sorry - but sometimes stuff just seems to make sense to me only.

Let me explain. I'm a For Next kind of guy. I saw his original code and saw what I thought was the problem. I didn't read his code and simply created my own sheet with his kind of data and wrote code to get to what I thought he wanted. I used Col A and B for my code. After he posted an example workbook it was easy to change the columns and run the code again.

I really don't understand some of these questions but I thought I did understand this one and it seemed to work for the OP.

Marvin

I'm confused.

Where did the OP mention putting the values in column J?

The original code was for column A and in the sample data it appears to be column B, no column J unless I missed it.

Final shot.

Sub test()
Dim rng As Range
Dim NoRows As Long
Dim arrValues

    Set rng = Range("B1")

    While rng.Value <> ""

        arrValues = Split(rng.Value, ",")
        NoRows = UBound(arrValues) + 1
        If UBound(arrValues) > 0 Then
            rng.Offset(1).Resize(NoRows - 1).EntireRow.Insert
            rng.EntireRow.Copy rng.Resize(NoRows).EntireRow
            rng.Resize(NoRows).Value = Application.Transpose(arrValues)
        End If
        Set rng = rng.Offset(NoRows)
    Wend

    Range("A:G").RemoveDuplicates Array(2), xlNo

End Sub