Hello,
I have a workbook that compares each spreadsheet against a list of required fields in another workbook and returns a row of countblanks for each required field. My boss has asked if I could have the countblank numbers change as we update the data in the blank fields. I have attached the spreadsheet for your reference. The current code is listed below. Any assistance would be greatly appreciated.Excel Compare Test Updated.xlsx
Sub CompareTest()
Dim wbCompare As Workbook
Dim wbField As Workbook
'if code is running from a compare test file
Set wbCompare = ThisWorkbook
'prompt to open compare test file
'cancel this first prompt if code is already running from compare test file
Ref_WBook = Application.GetOpenFilename("Excel File (*.xls), *.xls", Title:="Select Compare File")
If Ref_WBook <> "False" Then
Workbooks.Open Ref_WBook
Set wbCompare = ActiveWorkbook
End If
'prompt to open required field file
Ref_WBook = Application.GetOpenFilename("Excel File (*.xls), *.xls", Title:="Select Field File")
If Ref_WBook <> "False" Then
Workbooks.Open Ref_WBook
Set wbField = ActiveWorkbook
End If
'find last filled row in sheet 1
With wbCompare.Sheets(1)
rowsInB = .Range("B" & .Rows.Count).End(xlUp).Row
End With
'insert row at top for counting blanks
For i = 1 To wbCompare.Sheets.Count
wbCompare.Sheets(i).Range("A1").EntireRow.Insert
Next
'loop for all required fields
fieldRow = wbField.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
For fRow = 2 To fieldRow
fieldValue = wbField.Sheets(1).Range("A" & fRow).Value
'loop through sheets in compare test file
For sheetIndex = 1 To wbCompare.Sheets.Count
For searchRow = 2 To rowsInB + 1
With wbCompare.Sheets(sheetIndex)
For searchCol = 1 To .Columns.Count
'try finding the value and color the cell
If .Cells(searchRow, searchCol).Value = fieldValue Then
.Cells(searchRow, searchCol).Interior.Color = RGB(255, 255, 0)
.Cells(1, searchCol).Value = _
Application.WorksheetFunction.CountBlank(.Range(.Cells(2, searchCol), .Cells(rowsInB + 1, searchCol)))
End If
Next
End With
Next
Next
Next
wbCompare.Activate
End Sub
Bookmarks