SOLVED

Copying multiple columns to two

Copper Contributor

I have 3,216 columns the odd column numbers hold the email address and the even column numbers hold the group name.  I need to copy or merge the details to the first two columns.  How can I do that?  Thanks

10 Replies

@Harry1605 

Can you provide a small example of what the result should look like?

Sure Hans

Column 1, 3, 5, and the odds have email addresses - want to copy 3, 5, and other odd columns to column 1. The end result would be column 1 will have all the email address from the 1,608 odd number columns and the second column would be similar difference being it will hold the group name for the recipient. The relationship is that the two columns next to each other are the email address and its group. Thank you

@Harry1605 

Uh - wouldn't that result in ridiculously long values? Cell A1 or A2 would contain more than 1000 email addresses...

Hi Hans,

You are right column A will have 1000+ email address and column B will hold the group that the address belongs to - this relationship you resolved in my last question. The reason we need it like this is that we will be loading groups and members to ServiceNow and the bulk upload tool requires us to provide data in that manner - thanks

@Harry1605 

How do you want to combine the addresses? Separated by a comma? Or a space? A comma and a space? Something else?

@Hans Vogelaar no thats fine since:

 

- each cell in column A that is populated will hold 1 email address and column B will hold 1 group

 

So at the moment cell A has 36 cells populated from row 1 so does cell B since its the group cell A email belongs to.

 

Column C 34 emails need to go after the last email in column A and its equivalent group in column D goes into first empty cell in B (in this case B37) same working for remaining 3,600+ columns thanks

 

Column A

email address removed for privacy reasons

email address removed for privacy reasons

 

Column B

Group 1

Group 1

 

 

best response confirmed by Harry1605 (Copper Contributor)
Solution

@Harry1605 

Ah - I interpreted your request incorrectly.

If you have an insider version of Microsoft 365, there is probably a formula solution.

It might also be possible to use PowerQuery.

But here is a macro solution:

Sub Combine()
    Dim m As Long
    Dim n As Long
    Dim r As Long
    Dim c As Long
    Dim t As Long
    Application.ScreenUpdating = False
    m = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    n = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    t = Cells(Rows.Count, 1).End(xlUp).Row + 1
    For c = 3 To n Step 2
        m = Cells(Rows.Count, c).End(xlUp).Row
        Cells(t, 1).Resize(m - 3, 2).Value = Cells(4, c).Resize(m - 3, 2).Value
        t = t + m - 3
    Next c
    Application.ScreenUpdating = True
End Sub
Hi Hans,

Thanks for the code. However, there seems to be a runtime error 1004 it says application defined or object defined error - thanks

@Harry1605 

Which line is highlighted when you click Debug in the error message?

Hi Hans, just reran - problem was my side. I still had data sitting in the first two columns. Adding two blank columns at the beginning, ran the script and perfect got what I asked for. Once again thank you so much for all your support!
1 best response

Accepted Solutions
best response confirmed by Harry1605 (Copper Contributor)
Solution

@Harry1605 

Ah - I interpreted your request incorrectly.

If you have an insider version of Microsoft 365, there is probably a formula solution.

It might also be possible to use PowerQuery.

But here is a macro solution:

Sub Combine()
    Dim m As Long
    Dim n As Long
    Dim r As Long
    Dim c As Long
    Dim t As Long
    Application.ScreenUpdating = False
    m = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    n = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    t = Cells(Rows.Count, 1).End(xlUp).Row + 1
    For c = 3 To n Step 2
        m = Cells(Rows.Count, c).End(xlUp).Row
        Cells(t, 1).Resize(m - 3, 2).Value = Cells(4, c).Resize(m - 3, 2).Value
        t = t + m - 3
    Next c
    Application.ScreenUpdating = True
End Sub

View solution in original post