Untitled
unknown
plain_text
a year ago
2.4 kB
4
Indexable
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 NextHeader: Next header ' Display the result message If errorMsg = "" Then MsgBox "All values in the specified columns are the same.", vbInformation Else MsgBox errorMsg, vbCritical End If End Sub
Editor is loading...
Leave a Comment