For Loop appending 6 diff strings to 6 consec cells then rep

mawheele

New Member
Joined
Jul 16, 2007
Messages
14
I have a rather tricky situation. I want to append 6 different strings to 6 consecutive cells in a column, then repeat throughout the entire range of the column. Basically, I want

316
316
316
316
316
316
317
317
317
317
317
317

To Become:

TOC_TOT_316
TOC_NEW_316
TOC_ADD_316
TOC_REPAIR_316
316
316
TOC_TOT_317
TOC_NEW_317
TOC_ADD_317
TOC_REPAIR_317
317
317

Right now, my loop looks like this:


Code:
With Myrange
        For x = 1 To 6
            Select Case x
                Case 1
                    Mystr = "TOC_TOT_"
                    .Offset(0, 1).Columns.Insert
                    .Offset(0, 1).FormulaR1C1 = "=Concatenate(""" & Mystr & """, RC[-1])"
                    .Columns(1).EntireColumn.Formula = .Columns(1).Offset(0, 1).EntireColumn.Value
                    .Columns(1).Offset(0, 1).EntireColumn.Delete
                Case 2
                     Mystr = "TOC_NEW_"
                    .Offset(0, 1).Columns.Insert
                    .Offset(0, 1).FormulaR1C1 = "=Concatenate(""" & Mystr & """, RC[-1])"
                    .Columns(1).EntireColumn.Formula = .Columns(1).Offset(0, 1).EntireColumn.Value
                    .Columns(1).Offset(0, 1).EntireColumn.Delete
                Case 3
                     Mystr = "TOC_ADD_"
                    .Offset(0, 1).Columns.Insert
                    .Offset(0, 1).FormulaR1C1 = "=Concatenate(""" & Mystr & """, RC[-1])"
                    .Columns(1).EntireColumn.Formula = .Columns(1).Offset(0, 1).EntireColumn.Value
                    .Columns(1).Offset(0, 1).EntireColumn.Delete
                Case 4
                     Mystr = "TOC_REPAIR_"
                    .Offset(0, 1).Columns.Insert
                    .Offset(0, 1).FormulaR1C1 = "=Concatenate(""" & Mystr & """, RC[-1])"
                    .Columns(1).EntireColumn.Formula = .Columns(1).Offset(0, 1).EntireColumn.Value
                    .Columns(1).Offset(0, 1).EntireColumn.Delete
                Case 5
                     Mystr = ""
                    .Offset(0, 1).Columns.Insert
                    .Offset(0, 1).FormulaR1C1 = "=Concatenate(""" & Mystr & """, RC[-1])"
                    .Columns(1).EntireColumn.Formula = .Columns(1).Offset(0, 1).EntireColumn.Value
                    .Columns(1).Offset(0, 1).EntireColumn.Delete
                Case 6
                     Mystr = ""
                    .Offset(0, 1).Columns.Insert
                    .Offset(0, 1).FormulaR1C1 = "=Concatenate(""" & Mystr & """, RC[-1])"
                    .Columns(1).EntireColumn.Formula = .Columns(1).Offset(0, 1).EntireColumn.Value
                    .Columns(1).Offset(0, 1).EntireColumn.Delete
             End Select
            Next
 End With

I know its probably inefficient. Right now, its adding all those strings to every cell. Basically I need:

Code:
x = 1 To 6

to refer to the first 6 cells, and then repeat and do the next 6.
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,357
Office Version
  1. 365
Platform
  1. Windows
Why even loop?
Code:
Sub Concat()
Dim LastRow As Long

    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    Range("B1").Formula = "=""TOC_TOT_""& A1"
    Range("B2").Formula = "=""TOC_NEW_""& A2"
    Range("B3").Formula = "=""TOC_ADD_""& A3"
    Range("B4").Formula = "=""TOC_REPAIR_""& A4"
    Range("B5:B6").Formula = "=A5"
    
    Range("B1:B6").Copy Range("B7").Resize(LastRow - 6)
    Columns("B:B").Copy
    Columns("B:B").PasteSpecial xlPasteValues
    Columns("A:A").Delete
    Application.CutCopyMode = False
    
End Sub
 

Jonmo1

MrExcel MVP
Joined
Oct 12, 2006
Messages
44,061
Try this on for size

Code:
LR = Cells(Rows.Count, "A").End(xlUp).Row
For y = 0 To LR Step 6
    For x = 1 To 6
        If y + x > LR Then Exit Sub
        Select Case x
            Case 1
                Mystr = "TOC_TOT_"
                Cells(x + y, "A").Value = Mystr & Cells(x + y, "A").Value
            Case 2
                 Mystr = "TOC_NEW_"
                Cells(x + y, "A").Value = Mystr & Cells(x + y, "A").Value
            Case 3
                 Mystr = "TOC_ADD_"
                Cells(x + y, "A").Value = Mystr & Cells(x + y, "A").Value
            Case 4
                 Mystr = "TOC_REPAIR_"
                Cells(x + y, "A").Value = Mystr & Cells(x + y, "A").Value
            Case 5
                 Mystr = ""
                Cells(x + y, "A").Value = Mystr & Cells(x + y, "A").Value
            Case 6
                 Mystr = ""
                Cells(x + y, "A").Value = Mystr & Cells(x + y, "A").Value
         End Select
    Next x
Next y
 

pgc01

MrExcel MVP
Joined
Apr 25, 2006
Messages
19,887
Hi mawheele

Here's another one:
Code:
Sub App()
Dim rRng As Range

Set rRng = Range("A1", Range("A" & Rows.Count).End(xlUp))
rRng.Value = Evaluate("CHOOSE(MOD(ROW(" & rRng.Address & ")-1,6)+1," & _
            """TOC_TOT_"",""TOC_NEW_"",""TOC_ADD_"",""TOC_REPAIR_"", """", """")&" & rRng.Address)
End Sub

Hope this helps
PGC
 

Forum statistics

Threads
1,181,717
Messages
5,931,646
Members
436,796
Latest member
parthibanmuniswamy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top