VB Macro Programming

1. Validate data in excel

Tabs: data, reason, prod

Sub ValidateData()
Dim x As Integer

    'set error status and error message columns as Null
    Range("Data!CQ:CQ") = vbNullString
    Range("Data!CR:CR") = vbNullString

   
    'convert complete sheet to text format so that there are no scientific numerics
    Worksheets("Data").Activate
    Worksheets("Data").Range("A:CP").Select
    Selection.NumberFormat = "#"
   
    'Count Number of Rows in Sheet.
    Range("Data!A3").Select
    maxrow = 0
    Do Until ActiveCell.Value = vbNullString
        maxrow = ActiveCell.Row
        ActiveCell.Offset(1, 0).Select
    Loop
   
    'update number of rows in A1
    Cells(1, 1) = maxrow
    maxrow = maxrow + 1
    Range("Data!A1:CQ" & maxrow).Interior.ColorIndex = 15

    'Trx Date Validation Started ############################################
    Range("Data!E3").Select
    Do Until ActiveCell.Row = maxrow
        ' Check if the Trx Date is of Length 11 (DD-MON-YYYY)
        If Len(ActiveCell.Value) <> 11 Then
            ActiveCell.Interior.ColorIndex = 6 'Highlight with Yellow Color
            'update the flag = E
            Cells(ActiveCell.Row, 95).Value = "E"
            Cells(ActiveCell.Row, 96).Value = Cells(ActiveCell.Row, 96).Value & "- Trx Date has to be of Length 11"
        Else
            ActiveCell.Interior.ColorIndex = 15 'Retain Grey Color
        End If
       
        ActiveCell.Offset(1, 0).Select
    Loop
    'Trx Date Validation Completed '#############################################

    '##########GL Date Validation Started ############################################
    Range("Data!F3").Select
    Do Until ActiveCell.Row = maxrow
        ' Check if the GL Date is of Length 11
        If Len(ActiveCell.Value) <> 11 Then
            ActiveCell.Interior.ColorIndex = 6 'Highlight with Yellow Color
            'update the flag = E
            Cells(ActiveCell.Row, 95).Value = "E"
            Cells(ActiveCell.Row, 96).Value = Cells(ActiveCell.Row, 96).Value & "- GL Date has to be of Length 11"
        Else
            ActiveCell.Interior.ColorIndex = 15 'Retain Grey Color
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
    '#######GL Date Validation Completed '#############################################


 '##########Amount Validation Started ############################################
    Range("Data!AQ3").Select
    Do Until ActiveCell.Row = maxrow
   
    If IsNumeric(ActiveCell.Value) = True Then
   
                Dim av_pos As Integer
                av_pos = InStr(InStr(Cells(ActiveCell.Row, 8).Value, "_") + 3 _
                       , Cells(ActiveCell.Row, 8).Value _
                       , "_")
                        
                Dim av_trxType As String
                'extract CN, DN, GINV from trx type
                av_trxType = Mid(Cells(ActiveCell.Row, 8).Value, av_pos + 2, Len(Cells(ActiveCell.Row, 8).Value) - av_pos + 1)
               
        'MsgBox ("amount validation " & av_trxType)
        If av_trxType = "CN" And ActiveCell.Value > 0 Then
            ActiveCell.Interior.ColorIndex = 6 'Highlight with Yellow Color
            'update the flag = E
            Cells(ActiveCell.Row, 95).Value = "E"
            Cells(ActiveCell.Row, 96).Value = Cells(ActiveCell.Row, 96).Value & "- for CN Amount should be < 0"
        Else
            ActiveCell.Interior.ColorIndex = 15 'Retain Grey Color
        End If
   
        If (av_trxType = "DN" Or av_trxType = "INV") And ActiveCell.Value < 0 Then
            ActiveCell.Interior.ColorIndex = 6 'Highlight with Yellow Color
            'update the flag = E
            Cells(ActiveCell.Row, 95).Value = "E"
            Cells(ActiveCell.Row, 96).Value = Cells(ActiveCell.Row, 96).Value & "- for DN/inv Amount should be > 0"
        Else
            ActiveCell.Interior.ColorIndex = 15 'Retain Grey Color
        End If
   
    End If
    ActiveCell.Offset(1, 0).Select
    Loop
  '#######Amount Validation Completed '#############################################


    '##########UNIT PRICE Validation Started ############################################
    Range("Data!AQ3").Select
    Do Until ActiveCell.Row = maxrow
   
    If IsNumeric(ActiveCell.Value) = True Then
   
                Dim vup_pos As Integer
                vup_pos = InStr(InStr(Cells(ActiveCell.Row, 8).Value, "_") + 3 _
                       , Cells(ActiveCell.Row, 8).Value _
                       , "_")
                        
                Dim vup_trxType As String
                'extract CN, DN, GINV from trx type
                vup_trxType = Mid(Cells(ActiveCell.Row, 8).Value, vup_pos + 2, Len(Cells(ActiveCell.Row, 8).Value) - vup_pos + 1)
               
   
        'MsgBox ("unit price validation " & vup_trxType)
        If vup_trxType = "CN" And ActiveCell.Value > 0 Then
            ActiveCell.Interior.ColorIndex = 6 'Highlight with Yellow Color
            'update the flag = E
            Cells(ActiveCell.Row, 95).Value = "E"
            Cells(ActiveCell.Row, 96).Value = Cells(ActiveCell.Row, 96).Value & "- for CN Unit Price should be < 0"
        Else
            ActiveCell.Interior.ColorIndex = 15 'Retain Grey Color
        End If
   
        If (vup_trxType = "DN" Or vup_trxType = "INV") And ActiveCell.Value < 0 Then
            ActiveCell.Interior.ColorIndex = 6 'Highlight with Yellow Color
            'update the flag = E
            Cells(ActiveCell.Row, 95).Value = "E"
            Cells(ActiveCell.Row, 96).Value = Cells(ActiveCell.Row, 96).Value & "- for DN/inv Unit price should be > 0"
        Else
            ActiveCell.Interior.ColorIndex = 15 'Retain Grey Color
        End If
  
   
    End If
    ActiveCell.Offset(1, 0).Select
    Loop
  '#######UNIT PRICE Validation Completed '#############################################



 '##########Reason ############################################
    Range("Data!AA3").Select
    Dim xRow, yCol As Integer
   
    Do Until ActiveCell.Row = maxrow
    'xRow = ActiveCell.Row
    'yCol = ActiveCell.Column
   
    If Len(ActiveCell.Value) <> 0 Then
   
    ' Check if the Reason Code exists in list
        Dim vfound, vTrxTypefound As String
        vfound = vbNullString
        vTrxTypefound = vbNullString
       
        For Each c In Range("ReasonList!A1:A200")
                If c.Value = vbNullString Then
                    Exit For
                End If
           
            If c.Value = ActiveCell.Value Then
             
            vfound = vbNullString
            vTrxTypefound = vbNullString
             
              vfound = "Y"
              Dim trxTypeRef As String
              trxTypeRef = Range("ReasonList!B" & c.Row)
              
                'check if reason code is valid with doc type.
                Dim pos As Integer
                pos = InStr(InStr(Cells(ActiveCell.Row, 8).Value, "_") + 3 _
                       , Cells(ActiveCell.Row, 8).Value _
                       , "_")
                        
                Dim trxType As String
                'extract CN, DN, GINV from trx type
                trxType = Mid(Cells(ActiveCell.Row, 8).Value, pos + 2, Len(Cells(ActiveCell.Row, 8).Value) - pos + 1)
               
               'MsgBox ("trxtype " & trxType)
               'MsgBox ("trxTypeRef " & trxTypeRef)
                             
                             
               If trxType = "INV" Then
                   trxType = "DN"
               End If
              
               If trxType = trxTypeRef Then
                   vTrxTypefound = "Y"
                   'MsgBox ("matched trx types")
               Else
                   'MsgBox ("no match trx types")
                   vTrxTypefound = "N"
               End If
              
              Exit For
            End If
        Next c
       
        If vfound = vbNullString Then
            ActiveCell.Interior.ColorIndex = 6 'Highlight with Yellow Color
            'update the flag = E
            Cells(ActiveCell.Row, 95).Value = "E"
            Cells(ActiveCell.Row, 96).Value = Cells(ActiveCell.Row, 96).Value & "- Reason Code Not Found"
        Else
            ActiveCell.Interior.ColorIndex = 15 'Retain Grey Color
        End If
       
        If vTrxTypefound = "N" Then
            ActiveCell.Interior.ColorIndex = 6 'Highlight with Yellow Color
            Cells(ActiveCell.Row, 95).Value = "E"
            Cells(ActiveCell.Row, 96).Value = Cells(ActiveCell.Row, 96).Value & "- Reason Code for Trx Type Not Found"
        End If
       
       
       
    End If
   
    ActiveCell.Offset(1, 0).Select
    Loop
    '#######Reason Code Validation Completed '#############################################


 '##########ProductLine Code Validation Started ############################################
    Range("Data!AB3").Select
   
    Do Until ActiveCell.Row = maxrow
   
        If Len(ActiveCell.Value) <> 0 Then
       
        ' Check if the prodline Code exists in list
            Dim vProdLinefound As String
            vProdLinefound = vbNullString
           
            For Each c In Range("ProdList!A1:A1000")
               
                If c.Value = vbNullString Then
                    Exit For
                End If
               
                If c.Value = ActiveCell.Value Then
                  vProdLinefound = "Y"
                  Exit For
                End If
           
            Next c
           
            If vProdLinefound = vbNullString Then
                ActiveCell.Interior.ColorIndex = 6 'Highlight with Yellow Color
                'update the flag = E
                Cells(ActiveCell.Row, 95).Value = "E"
                Cells(ActiveCell.Row, 96).Value = Cells(ActiveCell.Row, 96).Value & "- ProductLine Not Found"
            Else
                ActiveCell.Interior.ColorIndex = 15 'Retain Grey Color
            End If
        End If
       
        ActiveCell.Offset(1, 0).Select
    Loop
    '#######ProductLine Code Validation Completed '#############################################

End Sub