Untitled
unknown
plain_text
2 years ago
2.4 kB
7
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