[RESOLVED] For next output to Excell cells

Originally posted this by mistake in the classic VBA forum a few weeks ago and haven't received any responses... still looking for any help. Thanks.

I have just started trying to program some macros for Excel. I am trying to change the code for a program I have. The current version will take a string of characters in a single cell in Excel such as "ABCDEFG" and put each letter in its own cell. I want to adapt this to three letters in each cell such as it will put "ABC" in one cell and "DEF" in another.

Here is my code so far:

VB Code:

Dim Words() As String
    Dim cell As Range, rng As Range, ans As Variant, rowformat As Variant, rng1 As Variant
    Dim i As Integer, k As Integer, N As Integer, L As Integer
    
    ans = MsgBox("place words in rows (Yes) or columns(No)?", vbYesNoCancel)
    If ans = vbYes Then
        rowformat = True
    ElseIf ans = vbNo Then
        rowformat = False
    ElseIf ans = vbCancel Then
        Exit Sub
    End If
    
    Set rng = Selection
    N = rng.Rows.Count
    rng.NumberFormat = "@"
    
    For Each cell In rng
        If Len(cell.Value) > L Then
            L = Len(cell.Value)
        End If
    Next cell
    
    ReDim Words(1 To N, 1 To L)
    For k = 1 To N
        For i = 1 To L Step 3
            Words(k, i) = UCase(Mid(rng.Cells(k), i, 3))
        Next i
    Next k
    
10  If rowformat Then
        On Error GoTo errorhandler
        Set rng1 = rng.Range(Cells(1, 1), Cells(N, L))
        rng1.Value = Words
    Else
        Set rng1 = rng.Range(Cells(1, 1), Cells(L, N))
        rng1.Value = Application.WorksheetFunction.Transpose(Words)
    End If
    rng1.NumberFormat = "@"
    
    Exit Sub
errorhandler:
    ans = MsgBox("string too long - column format?", vbYesNo)
    If ans = vbYes Then
        rowformat = False
        GoTo 10
    Else
        Exit Sub
    End If
    
End Sub

I just added the "Step 3" to get what I want, but the problem is that the output is also skipping 3 lines and I have two blank cells in between my ouput. How can I get rid of these blank cells? Thanks for all help in advance!

Matt

Your Step 3 causes the blank cells, as I'm sure you're aware. Why not just use i from 1 to L/3 and then L/3 in subsequent lines?

Alternatively, you could go through the entire range afterwards cell by cell checking the value - if "" then delete the cell using the Delete method. There is a Shift keyword which tells the cells which way to move.

Try recording a macro in VB and then delete a cell - it's a very handy way to get code.

HTH

zaza

Hi Zaza thanks for the reply. I tried replacing with i = 1 to L/3 and L/3 in the code, but still couldn't get the correct result. I'm wondering if you can be a little more specific or possibly show me the code you mean?

Also an alternate method I came up with is to remove blanks in the array using code like this:

VB Code:

j = 0
For m = 1 To L
    If Sequences(N, m) <> "" Then
    ReDim Preserve Sequences2(N, j)
    Sequences2(N, j) = Sequences(N, m)
    j = j + 1
    End If
Next

This almost works, but is giving me two arrays; one with all blanks and one with the correct values with no blanks, although I can't seem to get the rest of the code to output it correctly to the cells :sick:

M