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

Tagged as

Stats

3K views
105 downloads
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.

Introduction

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.

VBScript
Set fso = CreateObject("Scripting.FileSystemObject")

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

If fso.FileExists(sFilePath1) = False  Then
    MsgBox "File 1 is missing: " & sFilePath1
    Wscript.Quit
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
    oSheet.Activate

    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
                    oRange.MergeArea.UnMerge

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

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

                End If
            End If
        Next
    Next
Next

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
         Next
    Next
    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
    Else
        SheetExists = False
        Err.Clear
    End If
End Function

History

  • 1st December, 2020: Initial version

License

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.