简体   繁体   中英

VBA EXCEL Merging Rows in one Columns

So I have a column which lists through different modules, with some repeating for 5 rows, some for 20. I am trying to merge these through VBA however something is wrong with my code. Here is the Sub I am using for this, I have commented where the error comes after i debugged it line by line. Would appreciate any input on this error!

Thanks guys!

Notes:

  • i starts on 7 as that is the row where the module records start from.

     Sub ReMergeECURowsMPNT() Dim wsMPNT As Worksheet Set wsMPNT = Worksheets("Module Part Number Tracker") Dim lrowMPNT As Long lrowMPNT = CRC.LastRowInMPNT Dim i As Long Dim j As Long Dim sameRows As Boolean sameRows = True For i = 7 To lrowMPNT If StrComp(Cells(i, 3), Cells(i + 1, 3), vbTextCompare) Then sameRows = False End If If sameRows = False Then With wsMPNT .Range(Cells(i, 3), Cells(i + 1, 3)).Merge '''Application defined error on this line End With End If sameRows = True Next i 

    End Sub

Unless DisplayAlerts is set as False , you should typically get a prompt like "The selection contains multiple data values. Merging into one cell will keep the upper-left most data only." , and if clicked "Cancel" instead of "Ok" , VBA will throw an "Application-defined or object-defined error" .

Also, check the line lrowMPNT = CRC.LastRowInMPNT . If you are looking for merging "Column C" , you may try something as simple as this:

Sub ReMergeECURowsMPNT()
    Application.DisplayAlerts = False
    Dim wsMPNT As Worksheet, lrowMPNT As Long, i As Long, j As Long
    Set wsMPNT = Worksheets("Module Part Number Tracker")
    wsMPNT.Select
    lrowMPNT = wsMPNT.UsedRange.Row - 1 + wsMPNT.UsedRange.Rows.Count
    For i = 7 To lrowMPNT
        If Cells(i, 3) = Cells(i + 1, 3) Then
            j = j + 1
        ElseIf j > 0 Then
            Range(Cells(i - j, 3), Cells(i, 3)).Merge
            j = 0
        End If
    Next i
    Application.DisplayAlerts = True
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM