Looping through numbers to create a large table

Question

I have a code that works, but I want to add some more functionality to it. It currently does what it is supposed to do, and has sped up some processes, but now I think it can be sped up even more. I am using the solution that I marked as answered here: Using VBA to get a threshold value

But

I have this code:

Sub OutputEnergyToAllSheets()
Dim w
For Each w In ThisWorkbook.Worksheets
    If Not InStr(w.Name, "Total") > 0 And Not InStr(w.Name, "eV") Then
        OutputEnergyToSheet w.Name
    End If
Next w
End Sub

Sub OutputEnergyToSheet(TheSheet As String)
'y = Columns to check: 2-25
'x = Rows to check: 2-152
'z = check the next 4 cells
Dim x, y, z, check
'Clear the range where we store the #N/A or Energy Outputs
With Sheets(TheSheet)
    .Range("B153:Y153") = vbNullString
    For y = 2 To 25
        For x = 2 To 152
            If .Cells(x, y) > .Range("Z2") Then  'If value is greater than Z2
                check = True                   'Let's check the next 4
                For z = 1 To 30                'If any of them fail
                    If .Cells(x + z, y) < .Range("Z2") Then
                        check = False          'The check fails
                        Exit For
                    End If
                Next z
                If check = True Then                    'If the check doesn't fail
                    .Cells(153, y) = Int(.Cells(x, 1))  'Set cell 153 to the energy level
                    Exit For
                End If
            End If
        Next x                                   'If no energy level was set - #N/A
        If .Cells(153, y) = vbNullString Then .Cells(153, y) = ""
    Next y
End With
End Sub

But the line that says:

for z = 1 to 30

I am having to change from 0 to 100 in increments of 1. It outputs these values where it should on all worksheets and then I go to the sub and increase value and repeat. The values are output in each worksheet except a few in row 153. Is there a way to have 0 be in row 153, 1 be in 154, 2 in 155, etc up to 100? I understand if this is not possible, but it would me a TON of time, because I have to go through this process for many workbooks. If this can be done it will save me several monotonous hours of busy-work. Anyways, thanks for reading.

Answer 1

For this first code block, I tried to stay with the general structure of the code in your question. I could have for example swapped out the innermost two For loops for a single While loop. That would be more efficient but requires a significant logic change. I did make some changes though. I set everything to "N/A" at the beginning instead of the end and I added a condition to the last If statement. To implement your new functionality of checking for variable numbers of consecutive cells, I included another For loop with counter k around the For loop with counter z and made the end point of z dependent on k. We print out to row 152 + k.

Sub OutputEnergyToSheet(TheSheet As String)
    'y = Columns to check: 2-25
    'x = Rows to check: 2-152
    'k = number of matches in a row to find
    'z = check the next (k - 1) cells
    Dim x, y, z, check, k
    'Clear the range where we store the N/A or Energy Outputs
    With Sheets(TheSheet)
        .Range("B153:Y252") = "N/A"
        For y = 2 To 25
            For x = 2 To 151
                If .Cells(x, y) > .Range("Z2") Then  'If value is greater than Z2
                    For k = 1 To 100
                        check = True                   'Let's check the next k - 1
                        For z = 1 To k - 1             'If any of them fail
                            If .Cells(x + z, y) <= .Range("Z2") Then
                                check = False          'The check fails
                                Exit For
                            End If
                        Next z
                        If check = True And .Cells(152 + k, y) = "N/A" Then
                            .Cells(152 + k, y) = Int(.Cells(x, 1))
                        End If
                    Next k
                End If
            Next x
        Next y
    End With
End Sub

Before I did all this, I threw together my own method which is cleaner and runs much faster. The code below steps down the rows and maintains a running count of how many consecutive matches it has found. It eliminates a lot of checks because it only checks any given cell once. Down to 2 total loops! The code above was checking a cell many times over in the inner loops. The below code could probably be better by maintaining the values in an array (read/write in Excel is slow) and/or maintaining a counter of the maximum length I have already achieved for the current column. I stored most of my numbers as variables that can be easily and confidently modified.

Sub EfficientEnergy(ws As Worksheet)
    Dim r As Integer, c As Integer, ctr As Integer
    Dim compVal As Double
    Dim maxRow As Integer, maxCol As Integer, maxConsecutive As Integer
    maxRow = 151
    maxCol = 25
    maxConsecutive = 100
    compVal = ws.Cells(2, 26).Value
    ws.Range(ws.Cells(maxRow + 2, 2), ws.Cells(maxRow + maxConsecutive + 1, maxCol)).Value = "N/A"
    For c = 2 To maxCol
        ctr = 0
        For r = 2 To maxRow
            If ws.Cells(r, c).Value > compVal Then
                ctr = ctr + 1
                If ws.Cells(maxRow + 1 + ctr, c).Value = "N/A" Then
                   ws.Cells(maxRow + 1 + ctr, c).Value = ws.Cells(r - ctr + 1, 1).Value
                End If
            Else
                ctr = 0
            End If
        Next r
    Next c
End Sub

The code I am using to call these methods in my testing is (just comment out whichever one you aren't using):

Public Sub GetConsecutiveVals()
    'OutputEnergyToSheet ("Sheet1")
    Call EfficientEnergy(ActiveWorkbook.Worksheets("Sheet1"))
End Sub

Or to run on every worksheet in active workbook (untested):

Public Sub GetConsecutiveVals()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        'OutputEnergyToSheet (ws.Name)
        Call EfficientEnergy(ws)
    Next ws
End Sub

Place all your code in a module in a workbook. Open your workbook with data in Sheet1 (or change the code above to your sheet name). Hit Alt + F8 and then run the GetConsecutiveVals routine. If you don't see that method in the dialog window, make sure the workbook with the code and the workbook with your data are in the same Excel application window

Answer 2

Why use three loops when one would do?

Sub OutputEnergyToAllSheets()
    Dim w as worksheet
    For Each w In ThisWorkbook.Worksheets
        If Not InStr(1, w.Name, "Total") > 0 And Not InStr(1, w.Name, "eV") Then
            OutputEnergyToSheet w.Name
        End If
    Next w
End Sub

---

Sub OutputEnergyToSheet(TheSheet As String)
    Dim check as Boolean
    Dim rng as Range
    Dim c
    Dim ELevel as integer
    'Clear the range where we store the #N/A or Energy Outputs
    With Sheets(TheSheet)
        ' set all cells in row 153 = 0
        .Range("B153:Y153").value = 0 
        ELevel = .cells(2,26)
        ' Your range
        set rng = .Range(.Cells(2,2), .cells(25, 153))

        ' Loop through all cells in range
        For each c in rng.cells
            ' If value is greater then Z2 and respective column in row 153 = 0 and cell is not in 153 then change 153 = respective row column 1 
            If c.value > ELevel and .cells(153, c.column) = 0 and c.row <> 153 Then
                 .cells(153,c.column) = .cells(c.row, 1)
            ' If value is less then Z2 and cell is not in 153 then change 153 = 0
            elseif c.value < ELevel and c.row <> 153 then
                 .cells(153, c.column) = 0
            ' Clean up - if cell is in row 153 and value = 0 then change to "N/A"
            elseif c.row = 153 and c.value = 0 then
                c.value = "N/A"
            end if
        Next c
    End With
End Sub

Please let me know if I've misunderstood

Answer 3

@jack This is how i read this code. Check all cells from Column 2 - 25, Rows 2 - 152, if one of them is greater than Z2, Enter Zloop, Begin checking the next 30 rows, to see if any of those are smaller. if so do nothing, if one is, in cell 153,y = Column 1 same row, go to next column ..question: Why have Z only check 30? why not have it check the remaining 152 ...z= 1 to 152 - x ?

in any case i think this is what you want to do, create another variable say

DIM Result As Integer

Result = 153

''then below
If check = True Then                    'If the check doesn't fail
 ''.Cells(153, y) = Int(.Cells(x, 1))  'Set cell 153 to the energy level
 .Cells(Result, y) = Int(.Cells(x, 1))  'Set cell 153 to the energy level
Result = Result + 1
EXIT FOR