CloseISQ
CloseISQ

Reputation: 353

VBA copy cells from loop

I have a columns filled with string cells separated by spaces such as:

"abc def ghi jkl"
"abcde fghi jkl"
"abcdef ghijkl"
"abcdefghijkl"

My objectives are:

  1. When there is four words I take each of the first letters of each word
  2. When there is three words I take the first two letters of the first word and then each of the first letters of the following words
  3. When there is two words I take the first two letters of each word
  4. When there is only one word I take the first four letters

For each case I copy the resulting four letters found into another cell on the same row.

Being new to vba I didn't go very far. I started with Case 1 but it is incomplete and not returning anything:

Sub MyMacro()

Dim r As Range
Dim a, b, c, d, s As String
Dim v As Variant
Dim w As Worksheet

Set w = Worksheets("Sheet1")
w.Activate
Set r = w.Range("B1").End(xlDown).Rows

    For Each v In r.Cells

        If UBound(Split(v, " ")) = 3 Then
            a = Left(Split(v, " ")(0), 1)
            b = Left(Split(v, " ")(1), 1)
            c = Left(Split(v, " ")(2), 1)
            d = Left(Split(v, " ")(3), 1)
        End If

    Next

End Sub

Why aren't a, b, c and d not returning anything?

While I am looping through the cells of the range, how do I say that I want to copy the concatenated values of a, b, c and d into an adjacent cell?

Edited to replace "@" with " ".

Upvotes: 0

Views: 224

Answers (2)

Tim Williams
Tim Williams

Reputation: 166835

Sub MyMacro()

Dim r As Range
Dim a, b, c, d, s As String
Dim v As Variant
Dim w As Worksheet
Dim arr, res

Set w = Worksheets("Sheet1")
w.Activate
Set r = w.Range(w.Range("B1"), w.Range("B1").End(xlDown))

    For Each v In r.Cells
        arr = Split(v.Value, " ")
        select case ubound(arr)
            case 0: res=left(arr(0),4)
            case 1:'etc
            case 2:'etc
            case 3:'res = left(arr(0),1) & left(arr(1),1)'...etc 
            case else: res = "???"
        End Select
        v.offset(0,1).value=res
    Next v

End Sub

Upvotes: 2

Siddharth Rout
Siddharth Rout

Reputation: 149335

Let's say your worksheet looks like this

enter image description here

Then try this

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long, n As Long
    Dim MyAr, sval

    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 1 To lRow
            sval = .Range("A" & i).Value
            If InStr(1, sval, " ") Then
                MyAr = Split(sval, " ")
                n = UBound(MyAr) + 1
                Select Case n
                    Case 2:
                        .Range("B" & i).Value = Left(MyAr(0), 2) & Left(MyAr(1), 2)
                    Case 3
                        .Range("B" & i).Value = Left(MyAr(0), 2) & Left(MyAr(1), 1) & Left(MyAr(2), 1)
                    Case 4
                        .Range("B" & i).Value = Left(MyAr(0), 1) & Left(MyAr(1), 1) & _
                                                Left(MyAr(2), 1) & Left(MyAr(3), 1)
                End Select
            Else
                .Range("B" & i).Value = Left(sval, 4)
            End If
        Next i
    End With
End Sub

Output

enter image description here

Upvotes: 2

Related Questions