Announcement

Collapse
No announcement yet.

$5 USD Move data from one sheet to another.

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • $5 USD Move data from one sheet to another.



    I am in need of a formula or macro that would help me consolidate data into a cell in a different sheet. I thought I could use VLOOKUP, but I have not had any luck.

    Thanks all,
    Discover the magic of the internet at Imgur, a community powered entertainment destination. Lift your spirits with funny jokes, trending memes, entertaining gifs, inspiring stories, viral videos, and so much more.
    Last edited by dawknzz; 1 week ago.

  • #2
    I can look at this for you.
    We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

    Comment


    • #3
      I have a solution for you, I will PM you with my PayPal details and post the code here upon receipt of payment.
      We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

      Comment


      • #4


        Payment received, many thanks.

        Attached is a sample file, click the button.

        Code assigned to the button:
        Code:
        Sub CombineText()
            Dim x, y(), i As Long
            
            With ActiveSheet
                x = .Cells(1).CurrentRegion
                For i = 1 To UBound(x, 1)
                    iii = iii + 1: ReDim Preserve y(1 To 2, 1 To iii)
                    If i = UBound(x, 1) Then
                        y(1, iii) = x(i, 1): y(2, iii) = x(i, 2)
                    ElseIf x(i, 1) = x(i + 1, 1) Then
                        ii = i
                        Do Until x(ii, 1) <> x(i, 1)
                            If ii = i Then
                                y(1, iii) = x(ii, 1): y(2, iii) = x(ii, 2)
                            Else
                                y(1, iii) = x(ii, 1): y(2, iii) = y(2, iii) & vbLf & x(ii, 2)
                            End If
                            ii = ii + 1
                            If ii = UBound(x, 1) + 1 Then Exit For
                        Loop
                        i = ii - 1
                    Else
                        y(1, iii) = x(i, 1): y(2, iii) = x(i, 2)
                    End If
                Next
                Application.ScreenUpdating = 0
                .Columns(1).Resize(, 2).Clear
                With .[a1]
                    .Resize(iii, 2) = Application.Transpose(y)
                    .CurrentRegion.VerticalAlignment = -4108
                    .CurrentRegion.HorizontalAlignment = -4108
                End With
            End With
            
        End Sub
        Attached Files
        Last edited by KjBox; 1 week ago.
        We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

        Comment

        Working...
        X