I'll rephrase - give the contents of each column in a row it's own row.

[CarysW]

Bear with me if I'm not making sense, I will try to explain. I have a spreadsheet with a list of keys and a list of item keys. I need to create a new entry for each item key that belongs to a key(confused yet?) I will try to write an example rather than uploading an example but can upload if needed.

I have:
Key Items Keys
1010 1 5 7 9

I need
Key Item Key
1010 1
1010 5
1010 7
1010 9


Does that make any sense to anyone? If so do you know whether there is a macro or a formula that can do this for me without me manually having to insert and type as I have over 3000 entries and it's going to take me a few days!!!

 

[chergh]

Assuming keys are in Column A and each item key has its own column this should work:

Sub blah()


Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("Sheet1") 'this is the worksheet that currently contains your keys change name as appropriate
Set ws2 = wb.Worksheets("Sheet2") 'this is where the output you want will be

For i = 1 To ws1.Range("A65536").End(xlUp).Row

    For j = 2 To ws1.Range("IV" & i).End(xlToLeft).Column
    
        ws2.Range("A65536").End(xlUp).Offset(1, 0).Value = ws1.Range("A" & i).Value
        ws2.Range("A65536").End(xlUp).Offset(0, 1).Value = ws1.Cells(i, j).Value
    
    Next j
Next i

End Sub

 

[CarysW]

Thanks muchly, will give it a try.

 

[HaHoBe]

Hi, CarysW,

utilsing an array:

Sub CarysW()

Dim myarray As Variant
Dim lngRowCounter As Long
Dim lngColCounter As Long
Dim lngColMax As Long
Dim lngTargetRow As Long

With Sheets("Sheet1").Range("A1")
    myarray = .CurrentRegion
    lngColMax = .CurrentRegion.Columns.Count
End With

Application.ScreenUpdating = False
For lngRowCounter = 1 To UBound(myarray)
    For lngColCounter = 2 To lngColMax
        If Not IsEmpty(myarray(lngRowCounter, lngColCounter)) Then
            lngTargetRow = lngTargetRow + 1
            With Sheets("Sheet2")
                .Cells(lngTargetRow, 1).Value = myarray(lngRowCounter, 1)
                .Cells(lngTargetRow, 2).Value = myarray(lngRowCounter, lngColCounter)
            End With
        End If
    Next lngColCounter
Next lngRowCounter
Application.ScreenUpdating = True
End Sub

Ciao,
Holger

 

[CarysW]

Thanks HaHoBe. That worked relatively easily.

Now have a new similar problem to solve. The keys in Column A have general keys saved in a different workbook. Some of the keys in Column A have more than 1 key in the other workbook(basically the keys are stores and the numbers I have just sorted are brands that they sell).

So I need to give each key in the different workbook the set of rows for their Store key......I don't think that makes any sense...anyone?

 

[CarysW]

Maybe if I try and show an example of what I mean:

I now have
Key Item
1010 1
1010 5
1010 7
1010 9


and also another spreadsheet with: (this worksheet can be transferred so all in one file if needed)
Key(for Access) Key(store)
12 1010
13 1010
14 1010


What I need is:
Key(a) Key(s) Item
12 1010 1
12 1010 5
12 1010 7
12 1010 9
13 1010 1
13 1010 5
13 1010 7
13 1010 9
14 1010 1
14 1010 5
14 1010 7
14 1010 9

Does that make sense any more than before????

 

[Brianwarnock]

Export both tables to Access and do it there, then export back to a new sheet.

Brian

 

[HaHoBe]

Hi, Brain,

why change the application?

Sub CarysW2()
'to make things simple both arrays are taken from the very same worksheet
'should work woth sheets on 2 workbooks as well

Dim myarray As Variant
Dim myStores As Variant
Dim lngRowCounter As Long
Dim lngColCounter As Long
Dim lngColMax As Long
Dim lngTargetRow As Long
Dim lngStores As Long

With Sheets("Sheet1").Range("A1")
    myarray = .CurrentRegion
    lngColMax = .CurrentRegion.Columns.Count
End With

myStores = Sheets("Sheet1").Range("N1").CurrentRegion

Application.ScreenUpdating = False

lngStores = 1
For lngRowCounter = 1 To UBound(myarray)
    Do
        For lngColCounter = 2 To lngColMax
            If Not IsEmpty(myarray(lngRowCounter, lngColCounter)) Then
                lngTargetRow = lngTargetRow + 1
                With Sheets("Sheet2")
                    .Cells(lngTargetRow, 1).Value = myStores(lngStores, 1)
                    .Cells(lngTargetRow, 2).Value = myarray(lngRowCounter, 1)
                    .Cells(lngTargetRow, 3).Value = myarray(lngRowCounter, lngColCounter)
                End With
            End If
        Next lngColCounter
        lngStores = lngStores + 1
        If lngStores > UBound(myStores) Then Exit For
    Loop While myarray(lngRowCounter, 1) = myStores(lngStores, 2)
Next lngRowCounter
Application.ScreenUpdating = True
End Sub

Ciao,
Holger

 

[CarysW]

Thanks Brian, Access is the final destination of the list but without me actually knowing what to do with it there it would be pointless for me to try.

Thanks for the code Holger - I hope I don't sound like an idiot when I ask; which bits do I need to change to make it work? I've changed the sheet numbers accordingly but am now getting a run-time error 13.

 

[CarysW]

Hmmm....can't get it to work. I think I found the run-time problem, I changed N1 to C1, stopped the error but it has now put column B from the original sheet in both column A and B of the new sheet and disregards column A from the original sheet(the most important bit!) It is also only working for the first row in the original sheet.

Any ideas?

Just to add; I have now moved all of the data onto one worksheet, the info created above in Sheet 2 and the store info in Sheet 3.

 

[Brianwarnock]

Thanks Brian, Access is the final destination of the list but without me actually knowing what to do with it there it would be pointless for me to try.

.

In tht case definitely export the 2 worksheets to 2 tables.
In a query join them on key item and select the fields you want and Bob's your uncle.
Job Done

Brian