How to iterate through cell content based ranges in VBA - excel

Question

Currently, I want to automate some annoying work in excel and need some help.
I have a huge report which has 200k+ rows and about 500 columns and my task is to find out which cells of a column are never used.
This was fairly easy and I managed it to create a script that works for that so far.
But now I want to distinguish between row types and return for each row type whether there are columns that are never used.
My problem is that I do not know how to iterate through the contents of a cell, so that if the row type changes my script will count the empty columns for the next row type.
I hope you get the idea and can help me. You do not have to give me the full code but maybe an idea of how I can get to the solution :)
This is the vba code I currently have and that gives me the correct solution but without distinguishing between the rowtypes
Public row As Long
Public rowMax As Long
Public startRow As Integer
Public materialType As String
Public filter As String
Public col As Integer
Public colMax As Integer
Public isUsed As Boolean
Sub bestimmeObFelderGenutzt()
With Sheets("Sheet1")
filter = "I"
startRow = 2
rowMax = Sheets("Sheet1").Cells(.Rows.Count, "F").End(xlUp).row
colMax = Sheets("Sheet1").Cells(1, .Columns.Count).End(xlToLeft).Column
materialType = Sheets("Sheet1").Range(filter & startRow).Value
For col = 1 To colMax
Sheets("Sheet2").Cells(1, col + 2).Value = Sheets("Sheet1").Cells(1, col).Value
Next col
For row = 2 To rowMax
Sheets("Sheet2").Range("A" & row).Value = Sheets("Sheet1").Range("A" & row).Value
Sheets("Sheet2").Range("B" & row).Value = Sheets("Sheet1").Range("I" & row).Value
For col = 1 To colMax
If IsEmpty(Sheets("Sheet1").Cells(row, col)) = False Then
isUsed = True
Sheets("Sheet2").Cells(row, col + 2).Value = 1
Else:
Sheets("Sheet2").Cells(row, col + 2).Value = 0
End If
Next col
Next row
End With
End Sub
Sub findeUngenutzteSpalten()
With Sheets("Sheet2")
rowMax = Sheets("Sheet2").Cells(.Rows.Count, "F").End(xlUp).row
colMax = Sheets("Sheet2").Cells(1, .Columns.Count).End(xlToLeft).Column
Sheets("Sheet3").Cells(1, 1).Value = "Spaltenüberschrift"
Sheets("Sheet3").Cells(1, 2).Value = "Jemals benutzt?"
For col = 3 To colMax
isUsed = False
For row = 2 To rowMax
If Sheets("Sheet2").Cells(row, col).Value = 1 Then
Sheets("Sheet3").Range("A" & col - 1).Value = Sheets("Sheet2").Cells(1, col).Value
Sheets("Sheet3").Range("B" & col - 1).Value = "Ja"
GoTo WeiterCol
Else:
If row = rowMax Then
Sheets("Sheet3").Range("A" & col - 1).Value = Sheets("Sheet2").Cells(1, col).Value
Sheets("Sheet3").Range("B" & col - 1).Value = "Nein"
Else:
GoTo WeiterRow
End If
End If
WeiterRow:
Next row
WeiterCol:
Next col
End With
End Sub

Answer 1

If I understood your task correctly this should work, copy to your module and read comments:
Sub FindUnusedColumnsPerRow()
Dim cellRow As range, cellColumn As range
Dim rowRange As range, columnRange As range
Dim rowsCount As Long, columnsCount As Long
Dim insertRow As Long
Dim listOfEmptyColumns()
Dim i As Long, j As Long
Dim arrayCheck As Integer
With Sheets("Sheet1") ' I assume that this is your sheet with materials where you want to find unused columns
rowsCount = .Cells(Rows.Count, 6).End(xlUp).row ' get last row
columnsCount = .Cells(1, Columns.Count).End(xlToLeft).Column ' get last column
For Each cellRow In range(.Cells(2, 1), .Cells(rowsCount, 1)) ' going through all rows - here I suppose that material type is in the 1-st column, 1-st row is a header and data starts from 2-d row
For Each cellColumn In range(.Cells(cellRow.row, 2), .Cells(cellRow.row, columnsCount)) ' for each row looking through all columns - I suppose that data starts from 2-d column
If cellColumn = "" Then ' if the cell is empty.
ReDim Preserve listOfEmptyColumns(i) ' expanding array when needed
listOfEmptyColumns(i) = cellColumn.Column ' adding column number to an array, you may change it to = .cells(1,cellColumn.Column) to put a header name instead of column number
i = i + 1 ' increment the counter
End If
Next
On Error Resume Next ' a small trick to check whether the array with column numbers is empty
arrayCheck = UBound(listOfEmptyColumns) ' if the array is empty - an #9 "Subscript out of range" exception will be thrown
If Err.Number = 0 Then ' error number is 0 - means that there was no error
With Sheets("Sheet2") ' I suppose this is the sheet to store results
insertRow = .Cells(Rows.Count, 1).End(xlUp).row + 1 ' find the row to insert
.Cells(insertRow, 1) = cellRow.Value ' put the type to 1-st column
j = 2 ' start filling the row of the type with numbers of empty columns
For i = 0 To UBound(listOfEmptyColumns) ' populating data from array
.Cells(insertRow, j) = listOfEmptyColumns(i)
j = j + 1
Next
End With
End If
Err.Clear ' clearing the error, because it still holding an error information (if it was thrown)
On Error GoTo 0 ' don't forget to switch on normal error handling
Erase listOfEmptyColumns ' reset array before next row as the data is stored on sheet2
i = 0 ' reset the counter for further use
Next
End With
End Sub