Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 675
  • Last Modified:

Delete empty cells and merge columns

I have a rather large worksheet with over 50 columns.  I need these columns combined into one column, and manual cut and paste would take too long. And there are empty cells, I also need them to be removed. Finally all the columns needs to be merged into A. Any ideas? Thanks
file.xls
0
mmcompact
Asked:
mmcompact
  • 2
1 Solution
 
rspahitzCommented:
One Excel solution is to go to column 51 and enter a formula like =SUBSTITUTE(A1 & "," & B1 & "," & C1..., ",,", ",")

you could actually create an Excel formula to create this for you, but if it's a 1-time deal, maybe some VBA would be better.

Sub MergeColumns()
  For iRow=1 to iLastRow
    strMerge = ""
    For iColumn=1 to 50
      if Cells(iRow, iColumn).Value <> "" then
        strMerge = strMerge & "," & Cells(iRow, iColumn).Value
      End If
      Cells(iRow, 51).Value = mid(strMerge,2)
    Next iColumn
  Next iRow

' optionally add extra code to delete columns 1-50
End Sub
0
 
mmcompactAuthor Commented:
have you tried it on my attached file?
0
 
DaveCommented:

Using arrays does this quickly

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/A_2684-Using-varinat-arrays-in-VBA-for-large-scale-data.html

Your file with working code and button attached

Cheers

Dave
Sub QuickConcant()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim lngRow As Long
    Dim lngCnt As Long
    Dim X
    Dim Y
    Dim ws As Worksheet
    Set rng1 = Cells.SpecialCells(xlConstants)
    ReDim Y(1 To rng1.Cells.Count, 1 To 1)
    For Each rngarea In rng1.Areas
        'The most common outcome is used for the True outcome to optimise code speed
        If rngarea.Cells.Count > 1 Then
            'If there is more than once cell then set the variant array to the dimensions of the range area
            'Using Value2 provides a useful speed improvement over Value. On my testing it was 2% on blank cells, up to 10% on non-blanks
            X = rngarea.Value2
            For lngRow = 1 To rngarea.Rows.Count
                For lngCol = 1 To rngarea.Columns.Count
                    lngCnt = lngCnt + 1
                    Y(lngCnt, 1) = X(lngRow, lngCol)
                Next lngCol
            Next lngRow
            'Dump the updated array sans leading zeroes back over the initial range
            rngarea.Value2 = X
        Else
            'caters for a single cell range area. No variant array required
            lngCnt = lngCnt + 1
            Y(lngCnt, 1) = rngarea.Value2
        End If
    Next rngarea
    Set ws = Worksheets.Add
    ws.[a1].Resize(UBound(Y, 1), 1) = Y

End Sub

Open in new window

concat.xls
0
 
mmcompactAuthor Commented:
thanks, works great and very nice article
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now