I would like some feed back on the following code.
The Idea is as follows,
I have a control spreadsheet which will hold data headers for a variety of reports. The macro will compare the data headers in the report to ones held on the control spreadsheet with the aim to highlight/notify the user any addition/unexpected fields on the report.
The example below only includes 1 data header at the moment but I will expand it to include report selection later on. The Control header is listed A1:A
on the control sheet, the data header from report is then pasted next to this. From here various checks are carried out to see if they are identical and in the same alignment. The functions at the top are column and row finder functions that I like to use.
Option Explicit
Public Function lColCount(ws As Worksheet, Optional iWhichRow As Long = 1) As Long
Dim sMaxCol As String
sMaxCol = Cells(iWhichRow, ws.Columns.Count).Address
lColCount = ws.Range(sMaxCol).End(xlToLeft).Column
End Function
Public Function lRowCount(ws As Worksheet, Optional iWhichCol As Long = 1) As Long
Dim sMaxRow As String
sMaxRow = Cells(ws.Rows.Count, iWhichCol).Address
lRowCount = ws.Range(sMaxRow).End(xlUp).Row
End Function
Public Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function
Sub CheckTitles()
Dim I As Long
Dim InLoopCount As Long
Dim TitleErrorCount As Long
Dim Columns As Long
Dim ColumnsExpected As Long
Dim DataSht As Worksheet
Dim ContSht As Worksheet
Dim ColAlpha As String
Set DataSht = Sheet1
Set ContSht = Sheet2
''Clear Control sheet of prev workings
With ContSht
.Range("NumbColMatch").ClearContents
.Range("ControlTitles").ClearContents
.Range("Datatitles").ClearContents
.Range("ErrorCount1").ClearContents
.Range("ErrorCount2").ClearContents
.Range("K2:K1000").ClearContents
.Range("B1:B1000").ClearContents
.Cells.Interior.Color = xlNone
End With
ContSht.Range("NA").Value = "Check"
''Function for Column Numbers on data import & then control data titles - Control data title is in a V list
Columns = lColCount(DataSht, 1)
ColumnsExpected = lRowCount(ContSht, 1)
''Checks columns amounts match
If Columns = ColumnsExpected Then
ContSht.Range("numbcolmatch").Value = "YES"
Else
ContSht.Range("Numbcolmatch").Value = "NO"
End If
''Transposes Data titles next to control titles
ColAlpha = Col_Letter(Columns)
DataSht.Range("A1:" & ColAlpha & "1").Copy
ContSht.Range("B1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
''Formulas
ContSht.Range("C1:C" & Columns).Value = "=iferror(MATCH(A:A,B:B,0),CHECK)"
ContSht.Range("D1:D" & Columns).Value = "=iferror(MATCH(B:B,A:A,0),check)"
ContSht.Range("Errorcount1").Value = "=COUNTIF(C:C,Check)"
ContSht.Range("Errorcount2").Value = "=COUNTIF(D:D,check)"
''Checks for missing titles against control and vice versa
TitleErrorCount = ContSht.Range("Errorcount1").Value
If TitleErrorCount <> 0 Then
ContSht.Range("ControlTitles").Value = "NO"
Else
ContSht.Range("ControlTitles").Value = "YES"
End If
TitleErrorCount = 0
TitleErrorCount = ContSht.Range("Errorcount2").Value
If TitleErrorCount <> 0 Then
ContSht.Range("Datatitles").Value = "NO"
Else
ContSht.Range("Datatitles").Value = "YES"
End If
''Checks order of Data titles and provides list of titles in incorrect position to error list location in col K
InLoopCount = 2
I = 1
Do Until I = Columns + 1
If ContSht.Range("D" & I).Value <> ContSht.Range("D" & I).Row Then
ContSht.Range("K" & InLoopCount).Value = ContSht.Range("B" & I).Value
ContSht.Range("K" & InLoopCount).Interior.Color = rgbRed
ContSht.Range("B" & I).Interior.Color = rgbRed
InLoopCount = InLoopCount + 1
End If
I = I + 1
Loop
If ContSht.Range("NumbColMatch").Value = "YES" And ContSht.Range("ControlTitles").Value = "YES" _
And ContSht.Range("Datatitles").Value = "YES" And ContSht.Range("ErrorCount1").Value = 0 _
And ContSht.Range("ErrorCount2").Value = 0 Then
''Enter next import steps
MsgBox "Success"
Else
GoTo Abort
End If
Exit Sub
Abort:
MsgBox "Data import validation failed, please review control sheet"
End Sub