3
\$\begingroup\$

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
\$\endgroup\$
  • 3
    \$\begingroup\$ There is a standard way to find lastRow and lastColumn. That post explains why. \$\endgroup\$ – Raystafarian Mar 9 '17 at 22:40
  • \$\begingroup\$ Thanks, The method in my function is the same as the search for one column in that link. I will create a new function to look for last row in sheet \$\endgroup\$ – Rhys Williams Mar 10 '17 at 11:20
1
\$\begingroup\$

Naming convention

  • CamelCase (ColumnsExpected) vs underscore (Col_Letter)
  • sometimes specifying type (sMaxCol as String)
  • different abbreviations (ws vs ContSht)

Besides disturbing reading this also makes maintenance of your code more difficult

Named ranges

I'd define them as constants,

Const rngNumbColMatch = "NumbColMatch"
' ...
ContSht.Range(rngNumbColMatch).ClearContents

it has two benefits:

  • decrease probabilities of typos
  • one place to update range names when you change them

Variables used only once

TitleErrorCount = 0
TitleErrorCount = ContSht.Range("Errorcount2").Value
If TitleErrorCount <> 0 Then
  1. you don't need to reset a variable before setting a new value for it
  2. You use TitleErrorCount only once, why do you need it. You could use ContSht.Range("Errorcount2").Value directly in the If statement.

Do Until I = Columns + 1

This is a typical use of For: For I = 1 to Columns

GoTo Abort

Only accepted use of GoTo in VBA is for error handling, you best practice is to write the code clearly structured without the need of it.

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ Thanks for the notes. I will amend accordingly, instead of the goto abort would you use and exit sub under the else? \$\endgroup\$ – Rhys Williams Mar 15 '17 at 7:13
  • \$\begingroup\$ Your current sub ends anyway there. I would just omit Else. \$\endgroup\$ – Máté Juhász Mar 15 '17 at 11:16

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.