Finding the Column-CodePudding

I have an excel file with more that 5 column where cell values are TRUE and FALSE. The need is Comparing between the Columns and if all the cell value in each column is TRUE then in in 6th column cell enter "No change".

| 1    || 2    || 3    || 4    || 5    || 6    |
|:---- ||:---- ||:---- ||:---- ||:---- ||:---- |
| TRUE ||TRUE  ||TRUE  ||TRUE  ||TRUE  ||NO CHange  |

If any cell in these 5 column has value FALSE need to know the which column (2nd or 3rd or 5th)

| 1    || 2    || 3    || 4    || 5    || 6             |
|:---- ||:---- ||:---- ||:---- ||:---- ||:------------- |
|TRUE  ||FALSE ||TRUE  ||TRUE  ||TRUE  ||Change in 2nd  |

| 1    || 2    || 3    || 4    || 5    || 6                 |
|:---- ||:---- ||:---- ||:---- ||:---- ||:---------------   | 
|TRUE  ||FALSE ||TRUE  ||FALSE ||TRUE  ||Change in 2 and 4  |

Is this possible?

Not sure this is correct!

Sub Checking()
    Dim i as Integer
    For i=2 to $lastrow
        If (cell(i,1).value = cell(i,2).value = cell(i,3).value = cell(i,4).value = cell(i,5).value = "TRUE") Then 
           cell(i,"6").value = "No Change"
        Else 
            If (cell(i,1).value = "FALSE") Then
             cell(i,6).value = "1 Changed"
            End If
            If (cell(i,2).value = "FALSE") Then
             cell(i,6).value = "2 Changed"
            End If
            If (cell(i,3).value = "FALSE") Then
             cell(i,6).value = "3 changed"
            End If
            If (cell(i,4).value = "FALSE") Then
             cell(i,6).value = "4 Changed"
            End If
            If (cell(i,5).value = "FALSE") Then
             cell(i,6).value = "5 Changed"
            End If
       Next Cell
End Sub

CodePudding user response：

It's faster to process values in an array than accessing the cells 1 by 1
You should declare any variable used to store row number as Long. the maximum number of rows in a worksheet is much higher than what Integer data type can hold and can potentially cause overflow error. In general you also have no reason to use Integer data type in these days so just declare as Long.
It is good practice to declare all your variables, insert Option Explicit at the top of your module to help you enforce this.

Your code can not even compile due to various reasons so below code is not modified from your code:

Option Explicit

Sub Checking()
    Const firstRow As Long = 2
    Const firstColumn As Long = 1
    Const numToCompare As Long = 5
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1") 'Change name accordingly
    
    '== Find the last row
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, firstColumn).End(xlUp).Row
    
    '== Get the input values into an array to process faster vs accessing the cells 1 by 1
    Dim inputArr As Variant
    inputArr = ws.Range(ws.Cells(firstRow, firstColumn), ws.Cells(lastRow, firstColumn)).Resize(, numToCompare).Value
    
    Dim outputArr() As String
    ReDim outputArr(1 To UBound(inputArr, 1), 1 To 1) As String
    
    Dim i As Long
    Dim falseDict As Object
    
    '== Loop through the array row by row..
    For i = 1 To UBound(inputArr, 1)
        Set falseDict = CreateObject("Scripting.Dictionary")
        
        '== For each row, loop through each column to look for False value, add the column number to the dictionary if found
        Dim n As Long
        For n = 1 To UBound(inputArr, 2)
            If inputArr(i, n) = False Then falseDict(firstColumn   n - 1) = 1
        Next n
        
        'Determine the result string
        Dim output As String
        Select Case falseDict.Count
            Case 0: output = "No Change"
            Case Else
                Dim dictKeys As Variant
                dictKeys = falseDict.Keys
                output = "Change in " & Join(dictKeys, ", ")
        End Select
        
        outputArr(i, 1) = output
    Next i
    Set falseDict = Nothing
    
    'Output 1 column after the last column to compare
    Dim outputColumn As Long
    outputColumn = firstColumn   numToCompare
        
    ws.Cells(firstRow, outputColumn).Resize(UBound(outputArr, 1)).Value = outputArr
End Sub

CodePudding user response：

Alternative via Evaluation

Assuming the cell values in cell range A2:E2, I demonstrate an approach how one can use the results of a formula evaluation (getting an array of column numbers explicitly for the cells with value False) and join these elements to the wanted output string.

The logic behind the formula "=Not(A2:E2)*Column(A2:E2)" can be described as follows:

A2:E2 ...................... get the boolean values (true=1|false=0) as they appear in indicated cells
Not(A2:E2) ........... replace(each value by its opposite value: False ~> True=1, True ~> False=0)
*Column(A2:E2)... multiply with the cells' column number, thus receiving values greater than 0 (i.e. the respective column number as result of a multiplication with factor 1) only for the cells with an original False entry.

The eventual filtering allows to get the wanted column numbers exclusively, i.e. without zero values. Join combines the found elements to a resulting output string, which finally can be written to the 6th column (section c).

Option Explicit                          ' Force declaration of variables (head of code module)

Sub DetectFalseValues()
    Dim ws As Worksheet
    Set ws = Sheet1                      ' << change to required sheet Code(Name)
'a) get column numbers if original cell value equals False (negated as Not True);
'   (vice versa get zero for original True value after negation) 
    Dim allValues() As Variant
    allValues = ws.Evaluate("Not(A2:E2)*Column(A2:E2)")
'b) filter out all zero values and combine elements to string
    Dim output As String
    output = Join(Filter(allValues, 0, False), " and ")
    output = IIf(Len(output) = 0, "No Change", "Change in " & output)
'c) write to target
    ws.Range("F2").Value = output
    ''optional display in VB Editor's immediate window
    ' Debug.Print output                    ' e.g. "Change in 2 and 4"
End Sub