Creating a list from a new list utilizing VBA

[rubbery]

Hi there,

I'm certain I'm going to explain this badly, but here goes.

I have a list on one sheet, and I want to use that as a base to create another list.

So I've got...

A1: Listitem1
A2: Listitem2
A3: Listitem3

and I'd like...

A1: Listitem1 Required
A2: Listitem1 Actual
A3: Listitem2 Required
A4: Listitem2 Actual
A5: Listitem3 Required
A6: Listitem3 Actual

and I'd like it to iterate through as long as there are items in the original list.

Can anyone out there a little bit smarter than me help?

Thanks

[Solus Rankin]

Welcome to the forum! Any chance you could attach an example workbook with a before and after example?

To attach a workbook: Click the 'Go Advanced' button below, then use the paperclip button in the toolbar.

[Norie]

Try this.

Option Explicit
Sub NewList()
Dim rng As Range

    Set rng = Range("A1")

    Do Until rng.Value = ""
        With rng.Offset(1)
            .Insert xlShiftDown
            .Offset(-1).Value = rng.Value
            .Offset(-2, 1).Value = "Required"
            .Offset(-1, 1).Value = "Actual"
        End With
        Set rng = rng.Offset(2)
    Loop
    
End Sub

[rubbery]

Thanks both for the quick replies.

Norie, that worked beautifully, thanks! What would I need to add/change in order for the new list to be created on a separate sheet, named "dynamic list"?

Cheers,
Pete

[rubbery]

Also, I need them to be in the same cell, not split into two...

Thanks!

[Norie]

The code would be completely different if you wanted to create the new list on another worksheet.

As for the same cell, what exactly would you want in the same cell?

[rubbery]

I'll try to explain a little better...

I want the original list item repeated twice, with "required" or "actual" affixed to the end.

In a formula (which i'm far better with!) it would be either =CONCATENATE(A1," Required") or =A1& " Required"

Unfortunately I really need it on another sheet, I have to keep the original list in tact...

Thanks so much for the help! I've been struggling with this for days...

[Solus Rankin]

Sub NewList()
Dim l As Long
Dim lRow As Long

lRow = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

For l = 2 To lRow
    Sheets("dynamic list").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets("original list").Range("A" & l).Value & " Required"
    Sheets("dynamic list").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets("original list").Range("A" & l).Value & " Actual"
Next l
    
End Sub

You'll have to change the sheet name "original list" to whatever the sheet name you have.

[Norie]

Perhaps.

Option Explicit

Sub NewListNewSheet()
Dim rngSrc As Range
Dim rngDst As Range

    Set rngSrc = Worksheets("Sheet1").Range("A1")
    Set rngDst = Worksheets("Sheet2").Range("A1")
    
    Do Until rngSrc.Value = ""
    
        rngDst.Resize(2).Value = Application.Transpose(Array(rngSrc.Value & " Required", rngSrc.Value & " Actual"))
        Set rngDst = rngDst.Offset(2)
        Set rngSrc = rngSrc.Offset(1)
        
    Loop
End Sub

[rubbery]

Both those solutions work perfectly, thanks so much!

[Solus Rankin]

Glad to help. If you would, please mark the thread as [SOLVED] using the thread tools at the top.