Excel Merge Cells with Macro

[rizzo58]

Hi

I have data in an excel worksheet returned from a dbf database via MSQuery which contains addresses. For example;

Column A: Company Name
Column B: Add1
Column C: Add2
Column D: Add3
Column E: Town
Column F: Zip Code

I want to combine/merge the cells into a single cell placing a carriage return between each address line and remove any blank cells. For example;

Company Name
Add1
Town
Zip Code

Add2, Add3 are removed because they contain no data. In the next record they may contain data in which case they would appear in the merged cell.

I can merge the cells and insert carriage returns using CHAR(10) but I cannot work out how to remove the blank cells so that the address appears as contiguous in the merged cell. Can anyone help?

Thanks

[alex_read]

Hi, try this:

Private Sub CommandButton1_Click()
    Dim lastRowIndex As Integer
    Dim lastColumnIndex As Integer
    Dim rowCounterIndex As Integer
    Dim columnCounterIndex As Integer
    Dim currentAddress As String
    
    lastRowIndex = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    lastColumnIndex = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
    
    For rowCounterIndex = 1 To lastRowIndex
        currentAddress = ""
        For columnCounterIndex = 1 To lastColumnIndex
            If (Len(CStr(ActiveSheet.Cells(rowCounterIndex, columnCounterIndex))) > 0) Then
                currentAddress = currentAddress & CStr(ActiveSheet.Cells(rowCounterIndex, columnCounterIndex))
                currentAddress = currentAddress & Chr(10)
            End If
        Next columnCounterIndex
        ActiveSheet.Cells(rowCounterIndex, CInt(lastColumnIndex + 1)) = currentAddress
    Next rowCounterIndex
End Sub

[anhn]

In cell G2, enter

=$A2 & CHAR(10) & $B2 & IF($C2="","", CHAR(10) & $C2) & IF($D2="","", CHAR(10) & $D2) & IF($E2="","", CHAR(10) & $E2) & IF($F2="","", CHAR(10) & $F2)

or remove Add2 and Add3 if blank only:

=$A2 & CHAR(10) & $B2 & IF($C2="","", CHAR(10) & $C2) & IF($D2="","", CHAR(10) & $D2) & CHAR(10) & $E2 & CHAR(10) & $F2

then autofill down.

[rizzo58]

Hi anhn

Not being that familiar with VB used your formula which works perfectly.

Thanks really appreciate your help.

[anhn]

Please use Thread tools on the top to mark your thread as Resolved.