VBA Loop to highlight cells that do not meet character length requirements

[JoeRooney]

Hi ,

I have the below code that I want to tweak , I receive fileswith 820 columns (AEN) and each column has different character lengthrequirement.

EG. Column A ColumnB Column C Etc
Len = 3 Len = 10 Len= 50 Etc

I am trying to think of the easiest way to validate this. Asthere are so many columns I am thinking maybe have the macro import a spreadsheetthat contains all the required field lengths and then have the macro validateeach cell against the imported spreadsheet.

I am just not sure how to do it. Any advice or guidance isgreatly appreciated.

Sub Highlight()[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim sheetName As String
Dim startRow As Integer, startCol As Integer
Dim endRow As Integer, endCol As Integer
Dim row As Integer, col As Integer
Dim c As Integer[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]sheetName = "POL" 'Your sheetname[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]With Sheets(sheetName)[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    startRow = 4 'start row for the loop
    startCol = 1 'start column for the loop[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    endRow = .UsedRange.SpecialCells(xlCellTypeLastCell).row 'Last Used Row
    endCol = .UsedRange.SpecialCells(xlCellTypeLastCell).Column 'Last Used Column[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    c = 0[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    For row = startRow To endRow Step 1 'Loop through rows[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        For col = startCol To endCol - 1 Step 1 'Loop through columns[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            If Len(.Cells(row, col)) > 2 And Len(.Cells(row, col)) < 9 Then 'If value of cell is wrong[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                .Cells(row, col).Interior.Color = vbYellow 'mark cell in red
                c = c + 1[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Next col
    Next row[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    MsgBox "There were issues with " & c & " entries. See yellow cells" 'Warns that there are errors[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]End With[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]End Sub

 

[Fluff]

If you create a list like

Book1
	A	B
1	Min	Max
2	6	8
3	2	3
4	4	10
List

You could use

Sub JoeRooney()
   Dim Mx As Long, Mn As Long
   Dim r As Long, c As Long, UsdRws As Long
   Dim Cnt As Long
   Dim Ary As Variant
   
   With Sheets("List")
      Ary = .Range("A2", .Range("A" & Rows.Count).End(xlUp).Offset(, 1)).Value2
   End With
   With Sheets("POL")
      UsdRws = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
      For c = 1 To .UsedRange.SpecialCells(xlCellTypeLastCell).Column - 1
         Mx = .Evaluate("max(len(" & .Range(.Cells(4, c), .Cells(UsdRws, c)).Address & "))")
         Mn = .Evaluate("min(len(" & .Range(.Cells(4, c), .Cells(UsdRws, c)).Address & "))")
         If Mx > Ary(c, 2) Or Mn < Ary(c, 1) Then
            For r = 4 To UsdRws
               If Len(.Cells(r, c)) > Ary(c, 2) And Len(.Cells(r, c)) < Ary(c, 1) Then
                  .Cells(r, c).Interior.Color = vbYellow
                  Cnt = Cnt + 1
               End If
            Next r
         End If
      Next c
      MsgBox "There were issues with " & Cnt & " entries. See yellow cells" 'Warns that there are errors
   End With
End Sub

 

[JoeRooney]

Thank you for suggestion Fluff, I have tested it and it is running through successfully but it isn't finding any fields that don't meet the requirement.

 

[Fluff]

Ok, if you add this message box as shown

         Mx = .Evaluate("max(len(" & .Range(.Cells(4, c), .Cells(UsdRws, c)).Address & "))")
         Mn = .Evaluate("min(len(" & .Range(.Cells(4, c), .Cells(UsdRws, c)).Address & "))")
         [COLOR=#ff0000]MsgBox "Column " & c & vbLf & "Max " & Mx & " -- " & Ary(c, 2) & vbLf & "Min " & Mn & " -- " & Ary(c, 1)[/COLOR]
         If Mx > Ary(c, 2) Or Mn < Ary(c, 1) Then

It will return the column number, the max length found in the column, the max allowed for the column & then the same again for the Min values.
Do the values look right?

 

[JoeRooney]

Thanks , it now counts the length in column A but does not highlight if it is not correct.

 

[Fluff]

Oops this

               If Len(.Cells(r, c)) > Ary(c, 2) [COLOR=#ff0000]And[/COLOR] Len(.Cells(r, c)) < Ary(c, 1) Then

should be Or not And