need to add heading if data is less then 30

sksanjeev786

Well-known Member
Joined
Aug 5, 2020
Messages
1,015
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi Team

Below is the data B-D ,E-G,H-I, K-M, N-P will have in the same set with 3 columns and if any between 3 columns have less than 30 score
I need to add a note like Colunm B9..

Currently, B5 , F5, M5 have data less than so I have added those names Fro Row 6 to B9


book1
BCDEFGHIJKLMNOP
522270270571226081442442147780226117117
6DMA: AtlantaDMA: Dallas - Ft. WorthDMA: Los AngelesDMA: New York CityDMA: Washington, DC (Hagrstwn)
7
8
9DMA: Atlanta, DMA: Dallas - Ft. Worth, DMA: New York City
Sheet1
 
May be something like this,
VBA Code:
Sub Addheadingifdataislessthen30()
    Dim result      As String
    Dim startColumn As Integer
    Dim endColumn   As Integer
    Dim lastColumn  As Integer
    Dim i           As Integer
    Dim mergedCell  As Range
    Dim cell        As Range
    
    result = ""
    
    lastColumn = Cells(5, Columns.Count).End(xlToLeft).Column
    
    For startColumn = 2 To lastColumn Step 3
        endColumn = startColumn + 2
        
        If endColumn > lastColumn Then
            endColumn = lastColumn
        End If
        
        For i = startColumn To endColumn
            Set cell = Cells(5, i)
            
            If cell.Value < 30 Then
                Set mergedCell = cell.Offset(1, 0).MergeArea
                
                If result = "" Then
                    result = mergedCell.Cells(1, 1).Value
                Else
                    result = result & ", " & mergedCell.Cells(1, 1).Value
                End If
                
                Exit For
            End If
        Next i
    Next startColumn
    
    If result <> "" Then
        Range("B9").Value = result
    Else
        Range("B9").Value = "No values below 30"
    End If
End Sub
 
Upvote 0
Currently, B5 , F5, M5 have data less than so I have added those names Fro Row 6 to B9
What about N5 (26)?

Here is a formula approach assuming you are using your 365 version.

25 02 08.xlsm
BCDEFGHIJKLMNOP
522270270571226081442442147780226117117
6DMA: AtlantaDMA: Dallas - Ft. WorthDMA: Los AngelesDMA: New York CityDMA: Washington, DC (Hagrstwn)
7
8
9DMA: Atlanta, DMA: Dallas - Ft. Worth, DMA: New York City, DMA: Washington, DC (Hagrstwn)
<30
Cell Formulas
RangeFormula
B9B9=TEXTJOIN(", ",1,BYCOL(B6:P6,LAMBDA(c,IF(AND(c<>"",MIN(OFFSET(c,-1,0,1,3))<30),c,""))))
 
Upvote 0
If you did want a vba approach, you could try this

VBA Code:
Sub LessThan30()
  Dim c As Range
  Dim s As String
  
  For Each c In Range("B6", Cells(6, Columns.Count).End(xlToLeft))
    If Len(c.Value) > 0 Then
      If Application.Min(c.Offset(-1).Resize(, 3)) < 30 Then s = s & ", " & c.Value
    End If
  Next c
  Range("B9").Value = Mid(s, 3)
End Sub
 
Upvote 0
Try it.
Inspired by Peter_SSs's code.
VBA Code:
Sub Less30()
    Do
        x = Application.Min(Range("B5:D5").Offset(0, i))
        If x = 0 Then Exit Do
        If x < 30 Then y = y & "," & Chr(10) & Range("B5").Offset(1, i)
        i = i + 3
    Loop
    Range("B9") = Mid(y, 3)
End Sub
 
Upvote 0
I tried it but I don't like your method of finishing the loop. When I tried it I had 0 in cell C5 & got nothing as my result.
I also like to declare all my variables, so I would use something more like this

VBA Code:
Sub Less30_v2()
  Dim i As Long, lc As Long
  Dim x As Double
  Dim y As String
  
  lc = Cells(5, Columns.Count).End(xlToLeft).Column
  i = 2
  Do While i < lc
    x = Application.Min(Cells(5, i).Resize(, 3))
    If x < 30 Then y = y & ", " & Cells(6, i).Value
    i = i + 3
  Loop
  Range("B9") = Mid(y, 3)
End Sub
 
Upvote 0
Hi @sksanjeev786

It is advisable not to use volatile functions such as offset, indirect, etc.
More about volatile functions:

Try the following formula:
Excel Formula:
=TEXTJOIN(", ",1,BYCOL(B6:P6,LAMBDA(a,IF(MIN(TAKE(INDEX(a,1):P5,,3))<30,a,""))))

I also propose the following macro:
VBA Code:
Sub AddHeadingLess30()
  Dim j As Long, s As String
  For j = 2 To Cells(5, Columns.Count).End(1).Column Step 3
    If WorksheetFunction.Min(Cells(5, j).Resize(, 3)) < 30 Then s = s & Cells(6, j).Text & ", "
  Next
  If s <> "" Then [B9] = Left(s, Len(s) - 2)
End Sub

;)
 
Last edited:
Upvote 0
Hi @sksanjeev786

It is advisable not to use volatile functions such as offset, indirect, etc.
More about volatile functions:

Try the following formula:
Excel Formula:
=TEXTJOIN(", ",1,BYCOL(B6:P6,LAMBDA(a,IF(MIN(TAKE(INDEX(a,1):P5,,3))<30,a,""))))

I also propose the following macro:
VBA Code:
Sub AddHeadingLess30()
  Dim j As Long, s As String
  For j = 2 To Cells(5, Columns.Count).End(1).Column Step 3
    If WorksheetFunction.Min(Cells(5, j).Resize(, 3)) < 30 Then s = s & Cells(6, j).Text & ", "
  Next
  If s <> "" Then [B9] = Left(s, Len(s) - 2)
End Sub

;)
Hi Sir,

its is working very well :)
 
Last edited:
Upvote 0
May be something like this,
VBA Code:
Sub Addheadingifdataislessthen30()
    Dim result      As String
    Dim startColumn As Integer
    Dim endColumn   As Integer
    Dim lastColumn  As Integer
    Dim i           As Integer
    Dim mergedCell  As Range
    Dim cell        As Range
  
    result = ""
  
    lastColumn = Cells(5, Columns.Count).End(xlToLeft).Column
  
    For startColumn = 2 To lastColumn Step 3
        endColumn = startColumn + 2
      
        If endColumn > lastColumn Then
            endColumn = lastColumn
        End If
      
        For i = startColumn To endColumn
            Set cell = Cells(5, i)
          
            If cell.Value < 30 Then
                Set mergedCell = cell.Offset(1, 0).MergeArea
              
                If result = "" Then
                    result = mergedCell.Cells(1, 1).Value
                Else
                    result = result & ", " & mergedCell.Cells(1, 1).Value
                End If
              
                Exit For
            End If
        Next i
    Next startColumn
  
    If result <> "" Then
        Range("B9").Value = result
    Else
        Range("B9").Value = "No values below 30"
    End If
End Sub
Thank you so much Sir it is working :)
 
Upvote 0
Currently, B5 , F5, M5 have data less than so I have added those names Fro Row 6 to B9

In your example, you must also include N5

1739045123269.png
 
Upvote 0

Forum statistics

Threads
1,226,771
Messages
6,192,926
Members
453,767
Latest member
922aloose

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top