mail@pastecode.io avatar
3 days ago
2.4 kB
Sub CheckColumns()
    Dim ws As Worksheet
    Dim headers As Variant
    Dim header As Variant
    Dim colNum As Integer
    Dim lastRow As Long
    Dim i As Long
    Dim firstValue As Variant
    Dim isSame As Boolean
    Dim errorMsg As String

    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name

    ' List of headers to check
    headers = Array("Business Event", "Currency", "Entity", "Counterparty")
    ' Initialize error message
    errorMsg = ""
    ' Loop through each header in the list
    For Each header In headers
        ' Initialize variables
        colNum = -1
        isSame = True

        ' Find the column with the current header in row 9
        For i = 1 To ws.Cells(9, ws.Columns.Count).End(xlToLeft).Column
            If ws.Cells(9, i).Value = header Then
                colNum = i
                Exit For
            End If
        Next i

        ' Check if the column was found
        If colNum = -1 Then
            errorMsg = errorMsg & "Error: '" & header & "' column not found in row 9." & vbCrLf
            GoTo NextHeader
        End If

        ' Get the last row in the current column
        lastRow = ws.Cells(ws.Rows.Count, colNum).End(xlUp).Row

        ' If there are no rows below the header, skip to the next header
        If lastRow <= 9 Then
            errorMsg = errorMsg & "There are no values to check below the '" & header & "' header." & vbCrLf
            GoTo NextHeader
        End If

        ' Get the first value below the header
        firstValue = ws.Cells(10, colNum).Value

        ' Check if all values below the header are the same
        For i = 11 To lastRow
            If ws.Cells(i, colNum).Value <> firstValue Then
                isSame = False
                Exit For
            End If
        Next i

        ' If values are not the same, add to the error message
        If Not isSame Then
            errorMsg = errorMsg & "Error: Not all values in the '" & header & "' column are the same." & vbCrLf
        End If
    Next header

    ' Display the result message
    If errorMsg = "" Then
        MsgBox "All values in the specified columns are the same.", vbInformation
        MsgBox errorMsg, vbCritical
    End If
End Sub
Leave a Comment