Results 1 to 2 of 2

Thread: Shifting and combining columns using VBA

  1. #1

    Shifting and combining columns using VBA



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hi, I have VERY LITTLE knowledge in VBA. However, I need to complete this task, and it must be done in VBA.

    I have attached the data below. What I am trying to accomplish is hard to explain if you do not have the data in front of you.

    DATA: Data.xlsx

    What I am trying to do is this:

    I want to align all the "Amount and Kind of Material Used" cells into the same column. In this small data, the LAST column with "Amount and Kind of Material Used" is column R. So ideally, I want all the other "Amount and kind of material used" to shift over to column R as well. Keep in mind that this should move all other cells after "Amount and Kind of Material Used" as well.

    Once this is completed, I want to COMBINE ALL CELLS after the "Amount and Kind of Material Used" column into one cell with an underscore in between.

    can someone PLEASE help me with this?

    or help me START the code. I'm on Google reading VBA for dummies and it really isn't helping.

    Thanks.

  2. #2
    Acolyte millz's Avatar
    Join Date
    Aug 2013
    Location
    Singapore
    Posts
    32
    Articles
    0
    Hi texas, you can try this code below. I have written it as close as possible to do what you have described, also included some comments.

    Code:
    Sub Align_And_Combine()
        Dim i, k, lastCol, c(), lastData() As Long
        Dim tempStr As String
        lastCol = 1
        i = 1
        'Reading data (rows)
        Do While Cells(i, 1) <> ""
            k = 1
            ReDim Preserve lastData(i)
            'Reading data (columns)
            Do While Cells(i, k) <> ""
                lastData(i) = k 'last column number with data
                If InStr(1, Cells(i, k).Value, "Amount and kind", vbTextCompare) > 0 Then
                    If k > lastCol Then lastCol = k 'last column number that is "Amount and kind of material"
                    ReDim Preserve c(i)
                    c(i) = k 'save every row's "Amount and kind of material" column number
                End If
                k = k + 1
            Loop
            i = i + 1
        Loop
        i = 1
        'Arranging and combining
        Do While i <= UBound(c)
            'if this row's "Amount and kind of material" column number is not the same as the furthest, move the data accordingly
            If c(i) <> lastCol Then
                Range(Cells(i, 1), Cells(i, lastData(i))).Cut Destination:=Cells(i, lastCol - c(i) + 1)
            End If
            k = 1
            tempStr = ""
            'Read and combine data after "Amount and kind of material" column
            Do While Cells(i, lastCol + k) <> ""
                tempStr = tempStr & Cells(i, lastCol + k) & "_"
                k = k + 1
            Loop
            tempStr = Left(tempStr, Len(tempStr) - 1) 'remove the last underscore
            Range(Cells(i, lastCol + 1), Cells(i, lastCol + k)).ClearContents 'clears the cells
            Cells(i, lastCol + 1) = tempStr 'write the combined data
            i = i + 1
        Loop
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •