Click here to Skip to main content
15,507,526 members
Articles / Programming Languages / VBScript
Posted 1 Dec 2020

Tagged as


3 bookmarked

Unmerge Excel File

Rate me:
Please Sign up or sign in to vote.
1.64/5 (3 votes)
1 Dec 2020CPOL
This script is useful if you want to Unmerge Excel File prior to importing it to a database.
In this post, you will see how to unmerge an Excel file.


Drag and drop an Excel file on top of VBS file to unmerge.

Before unmerge:

After unmerge:

Using the Code

This script will unmerge merged ranges that are one cell wide and many rows deep.

Set fso = CreateObject("Scripting.FileSystemObject")

Dim sFilePath1
If WScript.Arguments.Count = 1 then
    sFilePath1 = WScript.Arguments(0)
    MsgBox("Please drag an excel file.")        
End If

If fso.FileExists(sFilePath1) = False  Then
    MsgBox "File 1 is missing: " & sFilePath1
End If

Dim oExcel: Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = True
oExcel.DisplayAlerts = false
Set oWorkBook1 = oExcel.Workbooks.Open(sFilePath1)

For Each oSheet in oWorkBook1.Worksheets

    iColCount = GetLastCol(oSheet)
    iRowsCount = GetLastRowWithData(oSheet)

    For iRow = 1 to iRowsCount
        For iCol = 1 to iColCount
            Set oRange = oSheet.Cells(iRow, iCol)
            If oRange.MergeCells Then
                If iRow > 1 And oRange.MergeArea.Count > 1 And _
                oRange.MergeArea.Columns.Count = 1 And oRange.MergeArea.Rows.Count > 1 Then
                    sValue = oRange.value
                    iRowCount = oRange.MergeArea.Rows.Count

                    For i = 2 to iRowCount
                        Set oCell = oSheet.Cells(iRow + (i-1), iCol)

                        If oCell.Value = "" Then
                            oCell.Value = sValue
                        End If                            

                End If
            End If

MsgBox "Done"

Function GetLastRowWithData(oSheet)
    Dim iMaxRow: iMaxRow = oSheet.UsedRange.Rows.Count
    If iMaxRow > 500 Then
        iMaxRow = oSheet.Cells.Find("*", oSheet.Cells(1, 1),  -4163, , 1, 2).Row
    End If

    Dim iRow, iCol
    For iRow = iMaxRow to 1 Step -1
         For iCol = 1 to oSheet.UsedRange.Columns.Count
            If Trim(oSheet.Cells(iRow, iCol).Value) <> "" Then
                GetLastRowWithData = iRow
                Exit Function
            End If
    GetLastRowWithData = 1
End Function

Function GetLastCol(st)
    on error resume next
    GetLastCol = st.Cells.Find("*", st.Cells(1, 1), , 2, 2, 2, False).Column
    If Err.number <> 0 Then
        GetLastCol = 0
    End If
End Function

Function SheetExists(oWorkBook, sName)
    on error resume next
    Dim oSheet: Set oSheet = oWorkBook.Worksheets(sName) 
    If Err.number = 0 Then
        SheetExists = True
        SheetExists = False
    End If
End Function


  • 1st December, 2020: Initial version


This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Written By
Web Developer
United States United States
Igor is a business intelligence consultant working in Tampa, Florida. He has a BS in Finance from University of South Carolina and Masters in Information Management System from University of South Florida. He also has following professional certifications: MCSD, MCDBA, MCAD.

Comments and Discussions

Questionmerge/unmerge - ? Pin
Victor Nijegorodov7-Jan-21 5:12
Victor Nijegorodov7-Jan-21 5:12 
Hi Igor,
could you explain:
a) how you got so called "merged" Excel file?
b) the algorithm you are using to "unmerge" it?

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.