Excel VBA Loop through Column Range to Mark Section Headers

Lantern

New Member
Joined
May 9, 2024
Messages
10
Office Version
  1. 365
Platform
  1. Windows
I have an Excel parts list in which the part section headers are to be hidden if no parts are selected within the section.

I need to loop through a column range that contains a formula-generated index to create a filter in the adjacent column. The part qty may be in one of many columns, so I created the Index to mark the part rows. Section rows that contain a part qty (as described below) are to be marked with a Y.

I've been testing my loops on a sample file that only shows an Index Column with no part information shown.

A section row starts where an Index Row = 1 and extends to where the next Index Row = 1.

Index Values:
0 = Blank Row (Desired Y/N result = N)
1 = Section Row (Desired Y/N result = Y if any parts in the section have a Qty > 0)
2 = Part Row with Qty = 0 (Desired Y/N result = N)
3 = Part Row with Qty > 0 (Desired Y/N result = Y)

The Index Col always starts at C4 and extends to the last row. There will be nothing in the file past the last parts row.

The Index Column can be a few to hundreds of rows long with zero to many variable length sections.

Suggestions, please.

Thanks.

Sample file below . . .

COUNT TEST 8.xlsm
BCDEFGHI
2
3Formula Generated IndexDesired Y/N VBA ResultsParts Row Index KeyParts Row Description
41Y0Blank
53Y1Section Header
62N2Blank Part
72N3Part w/Qty
82N
93Y
103Y
112N
122N
133Y
142N
150N
161N
172N
182N
192N
202N
210N
222N
232N
242N
250N
262N
271Y
280N
293Y
303Y
313Y
323Y
332Y
340N
351N
362N
372N
382N
392N
400N
410N
420N
43
Sheet1
 
@Lantern could you provide your 'working' parts list? And a description of what should actually happen, written from scratch (or summed up) to avoid errors and reading all posts first

Shouldn't take much time to fix.

P.S.: I wrote my code in regard to your coding experience.
Hence the many lines and details (to make it 'readable')

But I can adjust Akuini's code as well to suit your need (I guess)

Please let me know which code you prefer.
 
Upvote 0

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Pete,

To be able to start from the top cell in the index column, even if doesn't start with an index =1, AND to be able to adjust which column the Y/N result appears in (I use a few templates and the Y/N column can be a variable number of columns from the index column, and to the right or left of the index column) = Awesome.

Akuini's works except for the output column selection part. That was my miss.

I appreciate your note about my coding experience.

Akuini's code looks wickedly sweet, but your code is clearer to me. So based on my experience, I would go with Pete's.

Thanks
 
Upvote 0
Not sure if this is proper forum etiquette, but I unmarked Akuini's code as the solution.
No problem at all; feel free to choose whichever answer you like best.
the Y/N results column is two columns to the left of the Index column (not one column to the right).
Is column Data (Formula Generated Index) always in col C, so you want the result in col A?
If yes, then change this part:
VBA Code:
Range("D4").Resize(UBound(vb, 1), 1) = vb
to this:
VBA Code:
Range("A4").Resize(UBound(vb, 1), 1) = vb

But if col Data is not fixed then I can amend the code to suit.
 
Upvote 0
Here's the updated code, works with your requirements on my test sheet:

VBA Code:
Option Explicit

Public Sub IndexSection_Counts_V2()
   Application.ScreenUpdating = False
   
   Dim FirstRow As Long
   Dim LastRow As Long
   Dim SectionStart As Long
   Dim SectionEnd As Long
   Dim Qty As Long
   Dim i As Long
   Dim j As Long
   Dim IdxCol As Integer
   Dim ResCol As Integer
   
' ----------------------------------------
   ' SETTINGS / VARIABLES - change here
   ' Index for Data Column (starting with 1 = Column A, 2 = Column B, ...)
   IdxCol = 3
   ' Index for Column with Y/N results (starting with 1 = Column A, 2 = Column B, ...)
   ResCol = 4
   ' Index of first Row containing Data
   FirstRow = 4
' ----------------------------------------
   
   LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, IdxCol).End(xlUp).Row
   
   For i = FirstRow To LastRow
      SectionStart = i
      SectionEnd = NextSectionIndex(SectionStart, IdxCol, LastRow)
      Qty = 0
      For j = SectionStart To SectionEnd
         Select Case Cells(j, IdxCol)
            Case 0
               Cells(j, ResCol) = "N"
            Case 2
               Cells(j, ResCol) = "N"
            Case 3
               Cells(j, ResCol) = "Y"
               Qty = Qty + 1
         End Select
      Next j

      If Cells(SectionStart, IdxCol) = 1 Then
         If Qty > 0 Then
            Cells(SectionStart, ResCol) = "Y"
         Else
            Cells(SectionStart, ResCol) = "N"
         End If
      End If

      Qty = 0
   Next i

   Application.ScreenUpdating = True
End Sub

Private Function NextSectionIndex(PreviousSectionIndex As Long, CurrentColumn As Integer, LastRow As Long) As Long
   Dim i As Long
   
   For i = PreviousSectionIndex + 1 To LastRow
      If Cells(i, CurrentColumn) = 1 Then
         NextSectionIndex = i
         Exit Function
      End If
   Next i
   
   NextSectionIndex = LastRow
End Function
 
Upvote 0
Akuini,

With your code tips, I see now that I can position my columns anywhere in my final solution. It's very flexible. I moved my test columns to various positions on the test sheet and was able to get it to work every time.

Also, your code handles index values I did not anticipate - specifically blank cells and index values outside of my expected range (>3).

I'm going to do more testing in my actual templates, but I expect your code will work well for me.

Thanks.
 
Upvote 0
Pete,

Your code works great in all position I place my test columns.

It handles blank index values cells. I just added a case statement for any index values outside of my expected range (>3).

VBA Code:
Case Is > 3
    Cells(j, ResCol) = "N"
    Qty = Qty + 1

I'm going to do more testing in my actual templates, but I expect your code will work well for me.

Now, my issue is which code (Akuini's or Pete's) to use in my templates. This is certainly a good problem to have.

Thanks
 
Upvote 0
Glad the code works.
I revised the code to enhance its flexibility and tidiness.
VBA Code:
Sub Lantern_3()
Dim i As Long
Dim va, vb
Dim flag As Boolean
Dim xStart As Range

Set xStart = Range("C4") 'Data (Formula Generated Index) start at C4, change to suit
va = Range(xStart.Address, Cells(Rows.Count, xStart.Column).End(xlUp))
ReDim vb(1 To UBound(va, 1), 1 To 1)
For i = 1 To UBound(va, 1)
    If va(i, 1) = 3 Then vb(i, 1) = "Y" Else vb(i, 1) = "N"
    If va(i, 1) = 1 Then n = i: flag = True
        If flag = True Then
            If va(i, 1) = 3 Then
                vb(n, 1) = "Y"
                flag = False
            End If
        End If
Next
'put the result 2 columns to the left of xStart
xStart.Offset(0, -2).Resize(UBound(vb, 1), 1) = vb
End Sub
 
Upvote 0

Forum statistics

Threads
1,216,946
Messages
6,133,658
Members
449,822
Latest member
mrsunshine

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