Forum Discussion

lhvinsky's avatar
lhvinsky
Copper Contributor
Oct 01, 2020

Automatically merge cells within range while entering highest count

Hi there

I would like to know a formula that encompasses the following criterias:


- Count the number of rows within the same hour range value (extract highest count value)
- Merge cells belonging to the same hour range value and paste the highest count value within merged cell
- Repeat the process until last non-empty cell of the specified column (G column) is reached

Note:
Total G column cell count are not fixed and will always start with G1 and will end with an unpredictable the last non-empty cell count ... meaning the formula needs to first identify the last cell count within a range as well as to identify the last non-empty cell within the G column


5 Replies

  • lhvinsky 

    A Formula cannot merge cells but can return the count based on your criteria only.

    If you want to merge the cells based on the criteria as well, you will need VBA to achieve this.

     

    Place the following code on a Standard Module like Module1 and activate the sheet in which you want to count and merge the cells and run the macro on Module1 then.

     

    On Sheet1 in the attached,   I have placed some dummy date time stamps in column G and inserted a button called "Count and Merge" , you may click this button to run the code to get the desired output.

     

    Sub CountCellsForSameHours()
    Dim lr      As Long
    Dim i       As Long
    Dim j       As Long
    Dim rng     As Range
    Dim found   As Boolean
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    lr = Cells(Rows.Count, "G").End(xlUp).Row
    
    For i = 1 To lr
        If IsDate(Cells(i, "G")) Then
            If Not found Then Set rng = Cells(i, "H")
            If Hour(Cells(i, "G")) = Hour(Cells(i + 1, "G")) Then
                found = True
                j = j + 1
            Else
                Set rng = rng.Resize(j + 1)
                rng.Merge
                rng.Value = j + 1
                rng.HorizontalAlignment = xlCenter
                rng.VerticalAlignment = xlCenter
                Set rng = Nothing
                j = 0
                found = False
            End If
        End If
    Next i
    Application.ScreenUpdating = True
    End Sub

     

    • lhvinsky's avatar
      lhvinsky
      Copper Contributor

      Subodh_Tiwari_sktneer 

      Thank you for the quick reply ... everything works great accept for the merged cells for the earliest hour located at the very bottom (see screenshot) ... for some reason it is not merging and adding the counted result.

       

Resources