• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Re: Mark Pass/Fail Amendment macro for the specific column

L

laxman

New Member
Hi All,
I have done the macro code to mark pass or fail for the huge amount of data for the specific column.But i need to make some amendment as the requirement has been attached in the word document.

In the attached Macro d The column BF and BG part alrdy done and i have no issues.But i need to make amendment in the code for for the below requirements.

1. Column BH: dupe rows check If C,D,H,AF,AG are the same, then it Is a dupe (“failed”)

2. Column BJ: for the same vendor names (column H), if the account group [(column D) = either “ZM01” or “ZM07” or “ZM11”] and [“credit check number” and “tax number 2” and “vat number” are unique at the same time], then “OK”, else “FAILED”
//blanks are acceptable with the following conditions: If “US”, column U is allowed to be blank. If “GB” column V is allowed to be blank. Credit check has to be always filled in//

Example:

clip_image002.jpg
clip_image004.jpg
In this case we just have ZM01, so it will be clearly OK. (ZM14 and ZM05 can inherit the credit check, vat number and tax number 2 from the ZM01)



In this case the ZM01 and the ZM07 have the same credit check, vat number and tax number 2, so these are “FAILED” (ZM14 and ZM05 can inherit the credit check, vat number and tax number 2 from the ZM01)


3. Column BK: for the same vendor names (column H), if the account group [(column D) = either “ZM14” or “ZM05”] and “credit check number” (column G) is either unique or the same as the “credit check number” assigned to the “ZM01”, then “OK” else “FAILED
//blanks are acceptable with the following conditions: If “US”, column U is allowed to be blank. If “GB” column V is allowed to be blank. Credit check has to be always filled in//


4. Column BL: for the same vendor names (column H), if the account group [(column D) = either “ZM14” or “ZM05”] and “tax number 2” (column V) is either unique or the same as the “tax number 2” assigned to the “ZM01”, then “OK” else “FAILED
//blanks are acceptable with the following conditions: If “US”, column U is allowed to be blank. If “GB” column V is allowed to be blank. Credit check has to be always filled in//

Example:

clip_image005.png
In this case above the “tax number 2” was inherited from the “ZM01” record. The VAT is allowed to be blank (since the is a “US” vendor), the credit check is also inherited from the “ZM01” record. So these are all ok.

clip_image006.png
//blanks are acceptable with the following conditions: If “US”, column U is allowed to be blank. If “GB” column V is allowed to be blank. Credit check has to be always filled in//



In this case it is failed, because the ZM05 and the ZM14 are sharing the same Tax number 2.

//blanks are acceptable with the following conditions: If “US”, column U is allowed to be blank. If “GB” column V is allowed to be blank. Credit check has to be always filled in//


5. Column BM: for the same vendor names (column H), if the account group [(column D) = either “ZM14” or “ZM05”] and “vat number” (column U) is either unique or the same as the “vat number” assigned to the “ZM01”, then “OK” else “FAILED
//blanks are acceptable with the following conditions: If “US”, column U is allowed to be blank. If “GB” column V is allowed to be blank. Credit check has to be always filled in//


Actually im new to this forum.Hope i will get help from experts

Thanks in advance,
Lax
 
Code i have..

Code: 
Option Explicit

Private Const nFirstDataROW = 2
Private Const sAutoFilterRANGE = "A1:BZ1"


Sub MacroForColumnBF()
  'This puts 'OK' or 'FAILED in Column 'BF' based on the following:
  '
  'Pass 1:
  'Examine the contents of:
  'Column H  (Vendor Name)
  'Column AF (Bank Key)
  'Column AG (Acct No)
  '
  'Any rows with 'AF' and 'AG' both BLANK, are 'OK', provided all other entries for the same vendor are unique.
  '
  '
  'If there is a duplicate in any row for a specific Vendor in columns 'AF' and 'AG'
  'ALL rows for that vendor FAIL
 
  Dim i As Long
  Dim iRow As Long
  Dim iRowCountForThisVendor As Long
  Dim iLastRow As Long
 
  Dim bHaveFailure As Boolean

  Dim sAcccountKeyFromColumnD As String
  Dim sAcccountKeyPrevious As String
  Dim sAccountNumberFromColumnAG As String
  Dim sPreviousConcatenation As String
  Dim sBankKeyFromColumnAF As String
  Dim sConcatenation As String
  Dim sPassFailValue As String
  Dim sRange As String
  Dim sSortRange As String
  Dim sVendorNameFromColumnH As String
  Dim sVendorNamePrevious As String
 
 
  ''''''''''''''''''''''''''''''''''''''''''''''''
  'Initialization
  ''''''''''''''''''''''''''''''''''''''''''''''''
 
  'Make Sheet 'Load Data' the Active Sheet
  Sheets("Load Data").Select
 
  'Disable Events
  'Inhibit automatic calculation on the Active Sheet
  Application.EnableEvents = False
  ActiveSheet.EnableCalculation = False
 

  'Turn off AutoFilter
  ActiveSheet.AutoFilterMode = False
 
  'Get the Last Row
  iLastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
  'Remove all data from the failure Column 'BF'
  sRange = "BF2:BF" & iLastRow
  ActiveSheet.Range(sRange).ClearContents
   
  'Create the range to be sorted e.g. 'A1:BZ1436'
  sSortRange = Left(sAutoFilterRANGE, Len(sAutoFilterRANGE) - 1) & iLastRow
   
 
  ''''''''''''''''''''''''''''''''''''''''''''''''
  'Pass 1
  ''''''''''''''''''''''''''''''''''''''''''''''''
 
  'Sort by Column H (Vendor Name) - Primary Key
  'Sort by Column AF(Bank Key)  - Secondary Key
  'Sort by Column AG (Acct No)  - Tertiary Key
  Range(sSortRange).Sort _
        Key1:=Range("H1"), Order1:=xlAscending, _
        Key2:=Range("AF1"), Order2:=xlAscending, _
        Key3:=Range("AG1"), Order3:=xlAscending, _
        Header:=xlYes, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers, _
        DataOption2:=xlSortTextAsNumbers, _
        DataOption3:=xlSortTextAsNumbers
       
       
  sVendorNamePrevious = ""

  'Loop Through the data
  For iRow = nFirstDataROW To iLastRow
    sVendorNameFromColumnH = Trim(Cells(iRow, "H"))
   
    If sVendorNameFromColumnH <> sVendorNamePrevious Then
      'Output Results for the previous Vendor if the old Vendor is different from the current vendor
      If bHaveFailure = True Then
        sPassFailValue = "FAILED"
      Else
        sPassFailValue = "OK"
      End If
   
      'Put the same Pass/Fail value in all rows for a specific Vendor Name
      For i = 1 To iRowCountForThisVendor
        Cells(iRow, "BF").Offset(-i, 0) = sPassFailValue
      Next i
     
      'Prepare for the NEXT Vendor Name
      bHaveFailure = False
      iRowCountForThisVendor = 0
    End If
   
    'Process only if the Vendor Name is NOT BLANK
    If Len(sVendorNameFromColumnH) > 0 Then
   
      'Increment the Count for this Vendor
      iRowCountForThisVendor = iRowCountForThisVendor + 1
   
      'Get the values in 'AF' and 'AG'
      sBankKeyFromColumnAF = Trim(Cells(iRow, "AF"))
      sAccountNumberFromColumnAG = Trim(Cells(iRow, "AG"))
     
      'Get the concatenated value of'AF' and 'AG' for this row
      sConcatenation = sBankKeyFromColumnAF & sAccountNumberFromColumnAG
     
      'Set the failure flag if 'AF' and 'AG' are the same as the 'Previous values' of 'AF' and 'AG'
      If Len(sConcatenation) > 0 Then
        If iRowCountForThisVendor > 1 Then
          If sConcatenation = sPreviousConcatenation Then
            bHaveFailure = True
          End If
        End If
      End If
   
      'Save the current value as the Previous value
      sPreviousConcatenation = sConcatenation
   
    End If
   
    'Save the current value for comparison purposes later
    sVendorNamePrevious = sVendorNameFromColumnH
   
  Next iRow
 
 
  'Output Results for the LAST Vendor Key
  If bHaveFailure = True Then
    sPassFailValue = "FAILED"
  Else
    sPassFailValue = "OK"
  End If
   
  'Put the same Pass/Fail value in all rows for a specific Vendor Name
  'if the Vendor Name is NOT BLANK (Adjust the row number because 'for loop' increments past the last row)
  'iRow does not need to be adjusted - it already has been incremented beyond the last row
  For i = 1 To iRowCountForThisVendor
    Cells(iRow, "BF").Offset(-i, 0) = sPassFailValue
  Next i
 

 
  ''''''''''''''''''''''''''''''''''''''''''''''''
  'Termination
  ''''''''''''''''''''''''''''''''''''''''''''''''
 
  'Turn On AutoFilter
  ActiveSheet.Range(sAutoFilterRANGE).AutoFilter
 
  'Enable Events
  'Enabled automatic calculation on the Active worksheet (and calculate now)
  Application.EnableEvents = True
  ActiveSheet.EnableCalculation = True


End Sub
 
Code: 
Sub MacroForColumnBG()
  'This puts 'OK' or 'FAILED in Column 'BG' based on the following:
  '
  'Examine the contents of:
  'Column H (Vendor Name)
  'Column D (Account Group)
  '
  'If there is a duplicate Vendor Name and the Account Group is either either ZM05 or ZM014,
  'then the country (column P) associated to it should be the same as the the country (column P) associated to ZM01.
  'There can be multiple 'ZM01' codes - to PASS a line must match one of them.
  'If fail, then mark all the lines failed, otherwise OK

  Dim i As Long
  Dim iCountryCodesForZM01 As Long
  Dim iRow As Long
  Dim iRowCountForThisVendor As Long
  Dim iLastRow As Long
 
  Dim bHaveCountryCodeMatch As Boolean
  Dim bHaveFailure As Boolean

  Dim sAcccountKeyFromColumnD As String
  Dim sAcccountKeyPrevious As String
  Dim sCountryCodeFromColumnP As String
  Dim sCountryCodeForZM01() As String
  Dim sPassFailValue As String
  Dim sRange As String
  Dim sSortRange As String
  Dim sVendorNameFromColumnH As String
  Dim sVendorNamePrevious As String
 
 
  ''''''''''''''''''''''''''''''''''''''''''''''''
  'Initialization
  ''''''''''''''''''''''''''''''''''''''''''''''''
 
  'Make Sheet 'Load Data' the Active Sheet
  Sheets("Load Data").Select
 
  'Disable Events
  'Inhibit automatic calculation on the Active Sheet
  Application.EnableEvents = False
  ActiveSheet.EnableCalculation = False
 

  'Turn off AutoFilter
  ActiveSheet.AutoFilterMode = False
 
  'Get the Last Row
  iLastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
  'Remove all data from the failure Column 'BG'
  sRange = "BG2:BG" & iLastRow
  ActiveSheet.Range(sRange).ClearContents
   
  'Create the range to be sorted e.g. 'A1:BG1436'
  sSortRange = Left(sAutoFilterRANGE, Len(sAutoFilterRANGE) - 1) & iLastRow
   
 
  ''''''''''''''''''''''''''''''''''''''''''''''''
  'Calculate Results
  ''''''''''''''''''''''''''''''''''''''''''''''''
 
  'Sort by Column H (Vendor Name)  - Primary Key
  'Sort by Column D (Account Group) - Secondary Key
  Range(sSortRange).Sort _
        Key1:=Range("H1"), Order1:=xlAscending, _
        Key2:=Range("D1"), Order2:=xlAscending, _
        Header:=xlYes, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
 
  'Initialize variables
  sVendorNamePrevious = ""
  sAcccountKeyPrevious = ""
  iRowCountForThisVendor = 0
  iCountryCodesForZM01 = 0
  ReDim sCountryCodeForZM01(1 To 1)
 
  'Loop Through the data
  For iRow = nFirstDataROW To iLastRow
 
    'Get the input data
    sVendorNameFromColumnH = Trim(Cells(iRow, "H"))
    sAcccountKeyFromColumnD = Trim(Cells(iRow, "D"))
   
       
  'Output Results for the previous Vendor if the old Vendor is different from the current vendor
    If sVendorNameFromColumnH <> sVendorNamePrevious Then
      If bHaveFailure = True Then
        sPassFailValue = "FAILED"
      Else
        sPassFailValue = "OK"
      End If
   
      'Put the same Pass/Fail value in all rows for a specific Vendor Key
      For i = 1 To iRowCountForThisVendor
        Cells(iRow, "BG").Offset(-i, 0) = sPassFailValue
      Next i
     
      'Prepare for the NEXT Vendor Key
      bHaveFailure = False
      iRowCountForThisVendor = 0
      iCountryCodesForZM01 = 0
      ReDim sCountryCodeForZM01(1 To 1)
    End If
   
   
    'Increment the Count for this Vendor Key
    iRowCountForThisVendor = iRowCountForThisVendor + 1
       
    'Get the 'Country Code'
    sCountryCodeFromColumnP = Trim(Cells(iRow, "P"))
   
    'Make the Pass/Fail Test
    If iCountryCodesForZM01 > 0 Then
      If sAcccountKeyFromColumnD = "ZM05" Or sAcccountKeyFromColumnD = "ZM14" Then
     
        'Check the country code against all 'ZM01' country codes
        bHaveCountryCodeMatch = False
        For i = 1 To iCountryCodesForZM01
          If sCountryCodeFromColumnP = sCountryCodeForZM01(i) Then
            bHaveCountryCodeMatch = True
            Exit For
          End If
        Next i
        bHaveFailure = Not bHaveCountryCodeMatch
       
      End If
    End If
   
    'If the country code is 'ZM01' add the country code to the list for this vendor
    If sAcccountKeyFromColumnD = "ZM01" Then
        iCountryCodesForZM01 = iCountryCodesForZM01 + 1
        ReDim Preserve sCountryCodeForZM01(1 To iCountryCodesForZM01)
        sCountryCodeForZM01(iCountryCodesForZM01) = sCountryCodeFromColumnP
    End If
       
    'Save the current values as the Previous value
    sVendorNamePrevious = sVendorNameFromColumnH
   
  Next iRow
 
 
  'Output results for the items associated with the last row
  'NOTE" Row number is one greater than the last row because 'for loop' increments past the last row
  If bHaveFailure = True Then
    sPassFailValue = "FAILED"
  Else
    sPassFailValue = "OK"
  End If
   
  'Put the same Pass/Fail value in all rows for a specific Vendor Key
  For i = 1 To iRowCountForThisVendor
    Cells(iRow, "BG").Offset(-i, 0) = sPassFailValue
  Next i
 
  ''''''''''''''''''''''''''''''''''''''''''''''''
  'Termination
  ''''''''''''''''''''''''''''''''''''''''''''''''
 
  'Turn On AutoFilter
  ActiveSheet.Range(sAutoFilterRANGE).AutoFilter
 
  'Enable Events
  'Enabled automatic calculation on the Active worksheet (and calculate now)
  Application.EnableEvents = True
  ActiveSheet.EnableCalculation = True

End Sub

Sub clearBF()
    Columns("BF:BF").Select
    Selection.ClearContents
End Sub
Sub clearBG()
    Columns("BG:BG").Select
    Selection.ClearContents
End Sub
 
Code: 
Sub MacroForColumnBH()
  'This puts 'OK' or 'FAILED in Column 'BH' based on the following:
  '
  ' 'FAILED' if a duplicate Column C  (Vendor Number),
  '                                D  (Account Group),
  '                                H  (Vendor Name),
  '                                AF (Bank Key),
  '                                AG (Acct No)
  ' 'OK' otherwise

  Dim iRow As Long
  Dim iLastRow As Long
 
  Dim sPassFailValue As String
  Dim sPassFailValuePrevious As String
  Dim sRange As String
  Dim sSortRange As String
  Dim s1 As String
  Dim s2 As String
  Dim s3 As String
  Dim s4 As String
  Dim s5 As String
  Dim sValue As String
  Dim sValuePrevious As String
 
 
  ''''''''''''''''''''''''''''''''''''''''''''''''
  'Initialization
  ''''''''''''''''''''''''''''''''''''''''''''''''
 
  'Make Sheet 'Load Data' the Active Sheet
  Sheets("Load Data").Select
 
  'Disable Events
  'Inhibit automatic calculation on the Active Sheet
  Application.EnableEvents = False
  ActiveSheet.EnableCalculation = False
 

  'Turn off AutoFilter
  ActiveSheet.AutoFilterMode = False
 
  'Get the Last Row
  iLastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
  'Remove all data from the failure Column 'BF'
  sRange = "BH2:BH" & iLastRow
  ActiveSheet.Range(sRange).ClearContents
   
  'Concatenate columns C D H AF AG
  'Put the results in Column 'BH'
  For iRow = nFirstDataROW To iLastRow
    s1 = Cells(iRow, "C")
    s2 = Cells(iRow, "D")
    s3 = Cells(iRow, "H")
    s4 = Cells(iRow, "AF")
    s5 = Cells(iRow, "AG")
   
    Cells(iRow, "BH") = s1 & "-" & s2 & "-" & s3 & "-" & s4 & "-" & s5
  Next iRow
 
  'Create the range to be sorted e.g. 'A1:BZ1436'
  sSortRange = Left(sAutoFilterRANGE, Len(sAutoFilterRANGE) - 1) & iLastRow
     
  'Sort by Column BH
  Range(sSortRange).Sort _
        Key1:=Range("BH1"), Order1:=xlAscending, _
        Header:=xlYes, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers
       
       
  'Seed the Previous Value with the value from the first row
  sValuePrevious = Cells(nFirstDataROW, "BH")
       
  'Loop Through the data
  For iRow = nFirstDataROW + 1 To iLastRow
    sValue = Cells(iRow, "BH")
   
    If sValue <> sValuePrevious Then
      sPassFailValue = "OK"
    Else
      sPassFailValue = "FAILED"
    End If
   
    'Put the Pass/Fail value in the 'Previous Row' (only if it doesn't contain 'FAILED' already)
    sPassFailValuePrevious = Cells(iRow - 1, "BH")
    If sPassFailValuePrevious <> "FAILED" Then
      Cells(iRow - 1, "BH") = sPassFailValue
    End If
   
    'Put FAILED value in the current row if it is failed
    If sPassFailValue = "FAILED" Then
      Cells(iRow, "BH") = sPassFailValue
    End If
       
    'Save the current value for comparison purposes later
    sValuePrevious = sValue
   
  Next iRow

  'Output Results for the LAST Row (same as the value for the next to last row)
  Cells(iLastRow, "BH") = sPassFailValue
 
  ''''''''''''''''''''''''''''''''''''''''''''''''
  'Termination
  ''''''''''''''''''''''''''''''''''''''''''''''''
 
  'Turn On AutoFilter
  ActiveSheet.Range(sAutoFilterRANGE).AutoFilter
 
  'Enable Events
  'Enabled automatic calculation on the Active worksheet (and calculate now)
  Application.EnableEvents = True
  ActiveSheet.EnableCalculation = True


End Sub



Sub MacroForColumnBI()
  'This puts 'OK' or 'FAILED in Column 'BI' based on the following:
  '
  ''OK' if no leading or trailing spaces in any cell
  'otherwise 'FAILED'
  '
  'The Columns checked are column 'A' (=1) to column 'AN' (= 40)

  Dim iColumn As Long
  Dim iRow As Long
  Dim iLastRow As Long
 
  Dim sPassFailValue As String
  Dim sRange As String
  Dim sValue As String
 
 
  ''''''''''''''''''''''''''''''''''''''''''''''''
  'Initialization
  ''''''''''''''''''''''''''''''''''''''''''''''''
 
  'Make Sheet 'Load Data' the Active Sheet
  Sheets("Load Data").Select
 
  'Disable Events
  'Inhibit automatic calculation on the Active Sheet
  Application.EnableEvents = False
  ActiveSheet.EnableCalculation = False
 

  'Turn off AutoFilter
  ActiveSheet.AutoFilterMode = False
 
  'Get the Last Row
  iLastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
  'Remove all data from the failure Column 'BI'
  sRange = "BI2:BI" & iLastRow
  ActiveSheet.Range(sRange).ClearContents
   
 
  ''''''''''''''''''''''''''''''''''''''''''''''''
  'Calculate Results
  ''''''''''''''''''''''''''''''''''''''''''''''''
 
 
  'Loop Through the data
  For iRow = nFirstDataROW To iLastRow
 
    sPassFailValue = "OK"
 
    For iColumn = 1 To 40
      sValue = ActiveSheet.Cells(iRow, iColumn)
      If Len(sValue) <> Len(Trim(sValue)) Then
        sPassFailValue = "FAILED"
        Exit For
      End If
    Next iColumn
 
  'Output Results for the row
    ActiveSheet.Cells(iRow, "BI") = sPassFailValue
 
  Next iRow
   
  ''''''''''''''''''''''''''''''''''''''''''''''''
  'Termination
  ''''''''''''''''''''''''''''''''''''''''''''''''
 
  'Turn On AutoFilter
  ActiveSheet.Range(sAutoFilterRANGE).AutoFilter
 
  'Enable Events
  'Enabled automatic calculation on the Active worksheet (and calculate now)
  Application.EnableEvents = True
  ActiveSheet.EnableCalculation = True

End Sub
Sub clearBH()
    Columns("BH:BH").Select
    Selection.ClearContents
End Sub
Sub clearBI()
    Columns("BI:BI").Select
    Selection.ClearContents
End Sub
 
Hi Laxman ,

In case your file size exceeds 1 MB , you will not be able to upload your file to this forum ; in such cases , what is to be done is to upload the file to any public file-sharing website such as RapidShare , SpeedyShare , GoogleDocs , SkyDrive , DropBox , give others permission to access your file , get a share link from the website and post that link in this thread.

Narayan
 
You must log in or register to reply here.
Back
Top