Thursday, December 13, 2018

SRM Bid Comparision Automated Clean-Up with VBA

Requirement:

Delete unncessary rows and columns from SRM Bid Comparison Excel export so price comparision can be viewed at a glance without having to scroll

Challenge: 

Macro recrording cannot be used as the number of suppliers are and the number of items are not fixed.

Design:
  1. Remove blank rows 
  2. Delete unnecessary columns. 
    1. Count the number of columns
    2. Identify the columns to be deleted by checking the label
Before
After

Code:

Sub RFxCleanUp()

Dim headerRow As Integer, numberOfColumns As Integer, headerColumns As Integer

lineNumber = "Line Number"
Set findLineNumber = Range("A:A").Find(What:=lineNumber, LookIn:=xlValues, LookAt:=xlWhole)
headerColumns = findLineNumber.Row
numberOfColumns = WorksheetFunction.CountA(Rows(headerColumns))

For i = numberOfColumns To 1 Step -1

    If Cells(headerColumns, i) = lineNumber Then
        Columns(i).Delete
 
    ElseIf Cells(headerColumns, i) = "Award Status" Then
        Columns(i).Delete
 
    ElseIf Cells(headerColumns, i) = "Attributes" Then
        Columns(i).Delete
    ElseIf Cells(headerColumns, i) = "RFx Quantity" Then
        Columns(i).Delete
    ElseIf Cells(headerColumns, i) = "UoM" Then
        Columns(i).Delete
    ElseIf Cells(headerColumns, i) = "Required Date" Then
        Columns(i).Delete
    ElseIf Cells(headerColumns, i) = "Weight" Then
        Columns(i).Delete
    ElseIf Cells(headerColumns, i) = "Highest Weighted Score" Then
        Columns(i).Delete
    ElseIf Cells(headerColumns, i) = "Payment Terms" Then
        Columns(i).Delete
    ElseIf Cells(headerColumns, i) = "Incoterms" Then
        Columns(i).Delete
    ElseIf Cells(headerColumns, i) = "Supplier Remarks" Then
        Columns(i).Delete
    ElseIf Cells(headerColumns, i) = "Answer" Then
        Columns(i).Delete
    ElseIf Cells(headerColumns, i) = "Comments" Then
        Columns(i).Delete
    ElseIf Cells(headerColumns, i) = "Raw Score" Then
        Columns(i).Delete
    ElseIf Cells(headerColumns, i) = "Weighted Score" Then
        Columns(i).Delete
    End If

Next
 
Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub