Split Upper / Lower case + concatenate rows

**Biespet** · 09-19-2014, 06:42 PM

**p45cal** · 09-20-2014, 12:43 AM

**Biespet** · 09-20-2014, 02:41 AM

Originally Posted by p45cal

see attached.

super, this looks what I want to see.
I'm new with this, and run into following issue:
I copied my real dataset into column A and B and also added an extra number on the bottom.
Then I change this part of the formula (2 parts) to the last cell number in my dataset. but then I get following error message:

"You cannot change part of an array"

how can I solve this?

**snb** · 09-20-2014, 01:45 AM

Code:

Sub M_snb()
    ReDim sp(1 To Cells(1).CurrentRegion.Columns(1).SpecialCells(4).Areas.Count, 1 To 2)
    y = 1
    
    For Each ar In Cells(1).CurrentRegion.Columns(1).SpecialCells(4).Areas
        c00 = Join(Application.Transpose(ar.Offset(-1, 1).Resize(ar.Rows.Count + 1)))
        For j = 1 To Len(c00)
           If Mid(c00, j, 1) Like "[a-z]" Then
                sp(y, 1) = Left(c00, j - 1)
                sp(y, 2) = Mid(c00, j)
                y = y + 1
                Exit For
            End If
        Next
    Next
    
    Cells(20, 4).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub

**Biespet** · 09-20-2014, 02:18 AM

Originally Posted by snb

Code:

Sub M_snb()
    ReDim sp(1 To Cells(1).CurrentRegion.Columns(1).SpecialCells(4).Areas.Count, 1 To 2)
    y = 1
    
    For Each ar In Cells(1).CurrentRegion.Columns(1).SpecialCells(4).Areas
        c00 = Join(Application.Transpose(ar.Offset(-1, 1).Resize(ar.Rows.Count + 1)))
        For j = 1 To Len(c00)
           If Mid(c00, j, 1) Like "[a-z]" Then
                sp(y, 1) = Left(c00, j - 1)
                sp(y, 2) = Mid(c00, j)
                y = y + 1
                Exit For
            End If
        Next
    Next
    
    Cells(20, 4).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub

thanks for the effort, but in my real data set I also have ID's without blank cells below and this code isn't picking those up.

**p45cal** · 09-20-2014, 03:29 AM

The arrays are only 2 cells wide. You select the two cells, adjust the formula, then ctrl+shift+Enter to enter the formula into both cells. Then you can copy the pair of cells down.

**Biespet** · 09-20-2014, 06:07 PM

thanks p45cal

@snb, my appologies, I thought it didn't make a difference.
apperently seen the other solution, it doesn't.

**snb** · 09-20-2014, 05:00 PM

Please do not quote !

Why didn't you tell so in the first place ?

**snb** · 09-20-2014, 07:30 PM

It does; but you can only take it into account if the information doesn't lack.

Code:

Sub M_snb()
    ReDim sp(1 To Cells(1).CurrentRegion.Columns(1).SpecialCells(2).Count, 1 To 2)
    y = 1
    
    For Each cl In Cells(1).CurrentRegion.Columns(1).Offset(1).SpecialCells(2)
        c00 = cl.Offset(, 1)
        If cl.Offset(1) = "" Then c00 = Join(Application.Transpose(cl.Offset(, 1).Resize(cl.Resize(UBound(sp)).SpecialCells(4).Areas(1).Cells.Count + 1)))
        
        For j = 1 To Len(c00)
           If Mid(c00, j, 1) Like "[a-z]" Then
                sp(y, 1) = Left(c00, j - 1)
                sp(y, 2) = Mid(c00, j)
                y = y + 1
                Exit For
            End If
        Next
    Next
    
    Cells(20, 4).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub

**Biespet** · 09-20-2014, 11:12 PM

@SNB got an error running this code. but got the other one working in this thread, so thanks for your efforts!
@p45cal: thanks! it worked, you saved me a week of work!!!! much appreciated.