Moving data from a column to row and appending data to it

dawnoharding

New Member
Joined
Sep 17, 2022
Messages
3
Office Version
  1. 365
Platform
  1. Windows
I have a customer database from our system. The customer database is company details for example column A is company reference, column B is company name, column C is address etc. The last columns contain multiple email addresses for example column D, E, F etc. So all the email addresses for the company are listed in the same row. Some rows will have a couple of addresses and some go up to about twenty email addresses.

For my email management software, I can only have one email address per row when importing. I therefore need to be able to create a way to create a row for each email address and pull the company details in to the new row.

I am sure there must be a way but can't work it out.

Hope it makes sense any help would be great
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
12,443
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).
 
Upvote 0

dawnoharding

New Member
Joined
Sep 17, 2022
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Sorry at home without access to computer plus has customer data within so can't share.


Hopefully this will help
Currently have this (a more simplified version)

Col A. Col B. Col C. Col D. Col E
No. Name. Email1. Email2. Email3
123. Com. E1@e.com E2@e.com e3@e.com
124 Dom. F1@f.com f2@f.com f3@f.com
125 Eom. G1@g.com
126 Fom. P1@pp.com pl2@pp.com
127. Gom. E@ge.com F@ge.com H@ge.com


And need to change it to something like this

Col A. Col B. Col C.
No. Name. Email1.
123. Com. E1@e.com
123. Com. E2@e.com
123. Com. e3@e.com
124 Dom. F1@f.com
124 Dom. f2@f.com
124 Dom. f3@f.com
125 Eom. G1@g.com
126 Fom. P1@pp.com
126 Fom. pl2@pp.com
127. Gom. E@ge.com
127. Gom. F@ge.com
127. Gom. H@ge.com
 
Upvote 0

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
12,443
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
In which column is the first email address for each company?
 
Upvote 0

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
12,443
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
The result will be placed in Sheet2. Change the sheet names (in red) to suit your needs.
Rich (BB code):
Sub TransposeData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, lCol As Long, rng As Range, cnt As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    With srcWS
        For Each rng In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
            lCol = .Cells(rng.Row, .Columns.Count).End(xlToLeft).Column
            cnt = lCol - 4
            With desWS
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(cnt, 4).Value = rng.Resize(, 4).Value
                .Cells(.Rows.Count, "E").End(xlUp).Offset(1).Resize(cnt).Value = WorksheetFunction.Transpose(rng.Offset(, 4).Resize(, cnt))
            End With
        Next rng
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
2,208
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Not all that much different from Mumps. Just slightly shorter (as if that makes a difference!!!!).
Starts email addresses at the 3rd Column. Change as required.
Code:
Sub Or_So_Maybe()
Dim c As Range, sh1 As Worksheet, sh2 As Worksheet, amt As Long
Set sh1 = Worksheets("Sheet2")
Set sh2 = Worksheets("Sheet3")
    For Each c In sh1.Range("A2:A" & sh1.Cells(Rows.Count, 1).End(xlUp).Row)
    amt = sh1.Cells(c.Row, sh1.Columns.Count).End(xlToLeft).Column - 2
        With sh2.Cells(Rows.Count, 3).End(xlUp).Offset(1).Resize(amt)
            .Value = Application.Transpose(c.Offset(, 2).Resize(, amt).Value)
            .Offset(, -2).Resize(, 2).Value = c.Resize(, 2).Value
        End With
    Next c
End Sub
 
Upvote 0

Forum statistics

Threads
1,186,774
Messages
5,959,713
Members
438,442
Latest member
azedin4

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