0

I have recently tried using Macros to simplify some tasks under Excel 2010 as I am working with unfortunatey huge databanks.

I already found the code I needed to merge duplicate rows and concatening unique data/comments thanks to this life-saving thread: How to combine values from multiple rows into a single row in Excel?

The code was easy to understand for a beginner like me (I do want and try to understand what I am doing instead of just blindly copy-pasting). The only problem I have encountered is that the macro does not seem to stop at the last row, and ends up filling the rest of the excel sheet.

The desired result was obtained as seen in row 4 to 6, but starting row 29...image However you can see that starting on row 29, the macro keeps ading ";" in the 10th column.

Here is the code that I have adapted:

Sub merge_dupes_and_comments()
'define variables

Dim RowNum As Long, LastRow As Long

Application.ScreenUpdating = False

RowNum = 2
LastRow = Cells.SpecialCells(xlCellTypeLastCell).row
Range("A2", Cells(LastRow, 10)).Select

For Each row In Selection
    With Cells
    'if OC number matches
    If Cells(RowNum, 2) = Cells(RowNum + 1, 2) Then
        'and if position and material match
        If Cells(RowNum, 4) = Cells(RowNum + 1, 4) Then
        If Cells(RowNum, 5) = Cells(RowNum + 1, 5) Then
        'move updated comments up next to the old comment and delete empty line
            Cells(RowNum, 10) = Cells(RowNum, 10) & ";" & Cells(RowNum + 1, 10)
            Rows(RowNum + 1).EntireRow.Delete
       End If
        End If
         End If
         End With

RowNum = RowNum + 1
Next row

Application.ScreenUpdating = True

End Sub

I am not quite sure why it is not stoping and I do not want to input a specific end row as the database I am working with varies every week.

I tried to redefine the last row as:

Dim LastRow As Long

With ThisWorkbook.Worksheets("MasterData") 'enter name of the sheet you're working on
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        LastRow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).row
    Else
        LastRow = 1
    End If

But I have noted any changes.

I would be grateful for any help!

Many thanks in advance, KuroNavi

LPChip
  • 66,193
KuroNavi
  • 3

1 Answers1

0

Your last row is not the last row of the table, but there are 3 empty rows included at the bottom, which are filled by ; because your macro contains this line:

        Cells(RowNum, 10) = Cells(RowNum, 10) & ";" & Cells(RowNum + 1, 10)

This command basically says: join empty line with empty line and separate with;

But you do not want to check for empty lines. So your sub should be as follows:

Sub merge_dupes_and_comments()
    'define variables
    Dim RowNum As Integer, LastRow As Integer, EmptyCells as Integer

    Application.ScreenUpdating = False

    RowNum = 2
    LastRow = Cells.SpecialCells(xlCellTypeLastCell).row
    Range("A2", Cells(LastRow, 10)).Select

    For Each row In Selection
        'Do we have am empty row? If so exit the loop.
        'Lets count the amount of empty cells on the row.
        EmptyCells=0
        For c = 1 to 10   
            if Cells(RowNum,c) = "" then EmptyCells = EmptyCells+1
        Next c

        'If we find more than 9 empty cells, assume the row is empty, and exit the loop.
        if EmptyCells > 9 then exit for

        'Lets continue the duplicate checking
        'if OC number matches
        'and if position and material match
        If Cells(RowNum, 2) = Cells(RowNum + 1, 2) AND _
           Cells(RowNum, 4) = Cells(RowNum + 1, 4) AND _
           Cells(RowNum, 5) = Cells(RowNum + 1, 5) Then
           'move updated comments up next to the old comment and delete empty line
            Cells(RowNum, 10) = Cells(RowNum, 10) & ";" & Cells(RowNum + 1, 10)
            Rows(RowNum + 1).EntireRow.Delete
       End If

    RowNum = RowNum + 1
Next row

Application.ScreenUpdating = True

End Sub

I also changed the declaration of your variables from longs to integers, because you are working with whole numbers only that will not exceed the boundaries of an integer, so less memory consuming.

LPChip
  • 66,193