VBA code to Highlight cell in Red

[SamarthSalunkhe]

Hi All,

I am using below code to find unwanted character in cell, code is working fine but in addition I want code to highlight wrong value cell in red.

Sub Validate_File()

'Variable Declaration
Dim iCnt As Integer
Dim IpData As Range, DataRange As Range
Dim lr As Long

'-----------------------------------------------------------------------------------------------------------------------------------
'Below code will find Unwanted Characters in Account Number Column
        
    lr = Sheet1.Range("F" & Rows.Count).End(xlUp).Row
    
    'Create Object for Selected Range
    Set DataRange = Sheets("Tally Format").Range("F2:F" & lr)
    
    'Runnning for loop to check all available cells
    For Each IpData In DataRange
    For iCnt = 1 To Len(IpData.Value)
        
        If Not Mid(IpData.Value, iCnt, 1) Like "[0-9A-Z]" Then
            MsgBox "Unwanted Character fould in Column", vbExclamation, "Wrong A/c No"
            Exit Sub
        End If
    Next iCnt
    Next IpData
End Sub

Thank you in Advance

 

[SamarthSalunkhe]

Here is what I would recommend.
- Put a counter in the loop that counts the number of errors it find
- Remove the message box from the loop
- After the completion of both loops, put an IF...THEN that says IF the error counter > 0, then return a MsgBox

Thank you @Joe4 for your suggestion,

can you please update the above point in my code, sorry but I in learning stage.

 

[Joe4]

Thank you @Joe4 for your suggestion,

can you please update the above point in my code, sorry but I in learning stage.

Don't be afraid to do it out yourself. That is usually the best way to learn!

Try this:

Sub Validate_File()

'Variable Declaration
Dim iCnt As Integer
Dim IpData As Range, DataRange As Range
Dim lr As Long
Dim ctr As Long

'-----------------------------------------------------------------------------------------------------------------------------------
'Below code will find Unwanted Characters in Account Number Column
        
    lr = Sheet1.Range("F" & Rows.Count).End(xlUp).Row
    
    'Create Object for Selected Range
    Set DataRange = Sheets("Tally Format").Range("F2:F" & lr)
    
    'Runnning for loop to check all available cells
    For Each IpData In DataRange
        For iCnt = 1 To Len(IpData.Value)
        
            If Not Mid(IpData.Value, iCnt, 1) Like "[0-9A-Z]" Then
                IpData.Interior.Color = 255
'               Add one to error counter
                ctr = ctr + 1
                Exit For
            End If
            
        Next iCnt
        
    Next IpData
    
'   Return message box if any errors found
    If ctr > 0 Then
        MsgBox "Unwanted Character fould in Column", vbExclamation, "Wrong A/c No"
    End If
    
End Sub

 

[SamarthSalunkhe]

Hi All,

I am using below code to find unwanted character in cell, code is working fine but in addition I want code to highlight wrong value cell in red.

Sub Validate_File()

'Variable Declaration
Dim iCnt As Integer
Dim IpData As Range, DataRange As Range
Dim lr As Long

'-----------------------------------------------------------------------------------------------------------------------------------
'Below code will find Unwanted Characters in Account Number Column
     
    lr = Sheet1.Range("F" & Rows.Count).End(xlUp).Row
 
    'Create Object for Selected Range
    Set DataRange = Sheets("Tally Format").Range("F2:F" & lr)
 
    'Runnning for loop to check all available cells
    For Each IpData In DataRange
    For iCnt = 1 To Len(IpData.Value)
     
        If Not Mid(IpData.Value, iCnt, 1) Like "[0-9A-Z]" Then
            MsgBox "Unwanted Character fould in Column", vbExclamation, "Wrong A/c No"
            Exit Sub
        End If
    Next iCnt
    Next IpData
End Sub

Thank you in Advance

Thank you so much for your support and time,

I have merged below two cods, code is working fine but exit sub is not working after massage box.

required your final help to resolve this,

    'Variable Declaration
    Dim iCnt As Integer
    Dim IpData As Range, DataRange As Range
    Dim sData As String, sTmp As String
    Dim lr As Long
    Dim ctr As Long
    Dim ctr1 As Long

'Below code will find Unwanted Characters in Account Number Column
      
Sheet3.Unprotect ("Rudra@130357")

    lr = Sheet3.Range("F" & Rows.Count).End(xlUp).Row
  
    'Create Object for Selected Range
    Set DataRange = Sheet3.Range("F8:F" & lr + 7)
  
    'Runnning for loop to check all available cells
    For Each IpData In DataRange
    For iCnt = 1 To Len(IpData.Value)
      
        If Not Mid(IpData.Value, iCnt, 1) Like "[0-9A-Z]" Then
            IpData.Interior.ColorIndex = 45
            ctr = ctr + 1
        Exit For
        End If
    Next iCnt
    Next IpData
  
'-----------------------------------------------------------------------------------------------------------------------------------
  
    lr = Sheet3.Range("G" & Rows.Count).End(xlUp).Row
  
    'Create Object for Selected Range
    Set DataRange = Sheet3.Range("G8:G" & lr + 7)
  
    'Runnning for loop to check all available cells
    For Each IpData In DataRange
    For iCnt = 1 To Len(IpData.Value)
      
        If Not Mid(IpData.Value, iCnt, 1) Like "[0-9A-Z]" Then
            IpData.Interior.ColorIndex = 45
          
        ElseIf Len(IpData) <> 11 Then
            IpData.Interior.ColorIndex = 45
          
            ctr1 = ctr1 + 1
        Exit For
        End If
      
    Next iCnt
    Next IpData
    
        If ctr > 0 Then
            MsgBox "Unwanted Character found in A/c No", vbExclamation, "Wrong A/c No"
  
        ElseIf ctr1 > 0 Then
            MsgBox "Unwanted Character / Less than 11 digits found in IFSC Code", vbExclamation, "Wrong IFSC Code"
            Exit Sub
        End If

Thank you

 

[Joe4]

Please post your ENTIRE procedure, all the way down to the "End Sub"

 

[SamarthSalunkhe]

Please post your ENTIRE procedure, all the way down to the "End Sub"

Sorry joe didn't understand, what i have to change.

 

[Joe4]

Sorry joe didn't understand, what i have to change.

In your previous post, you posted your code, but only as far down as the "End If".
Please post ALL the code in that procedure, all the way down to the "End Sub" line.
I need to see what is after what you already posted, down to the end of the procedure.

 

[SamarthSalunkhe]

In your previous post, you posted your code, but only as far down as the "End If".
Please post ALL the code in that procedure, all the way down to the "End Sub" line.
I need to see what is after what you already posted, down to the end of the procedure.

hi Joe please find code as below.

Option Explicit

Dim WbNew As Workbook
 
Sub Make_File()

'Below code will stop process when data is not imported

    If Sheet3.Range("A1").Value = "" Then
    MsgBox "Please import data first and then Generate File", vbExclamation, "Conversion Failed"
    
    Exit Sub
End If
'-----------------------------------------------------------------------------------------------------------------------------------

    'Variable Declaration
    Dim iCnt As Integer
    Dim IpData As Range, DataRange As Range
    Dim sData As String, sTmp As String
    Dim lr As Long
    Dim ctr As Long

Sheet3.Unprotect ("Rudra@130357")

'Below code will find Unwanted Characters in Account Number Column

    lr = Sheet3.Range("F" & Rows.Count).End(xlUp).Row
    
    'Create Object for Selected Range
    Set DataRange = Sheet3.Range("F8:F" & lr + 7)
    
    'Runnning for loop to check all available cells
    For Each IpData In DataRange
    For iCnt = 1 To Len(IpData.Value)
        
        If Not Mid(IpData.Value, iCnt, 1) Like "[0-9A-Z]" Then
            IpData.Interior.ColorIndex = 45
            ctr = ctr + 1
        Exit For
        End If
    Next iCnt
    Next IpData
    
    If ctr > 0 Then
        MsgBox "Unwanted Character fould in A/c No", vbExclamation, "Wrong A/c No"
        Exit Sub
    End If
'-----------------------------------------------------------------------------------------------------------------------------------
'Below code will find Unwanted Characters in IFSC Code Column
  
    lr = Sheet3.Range("G" & Rows.Count).End(xlUp).Row
    
    'Create Object for Selected Range
    Set DataRange = Sheet3.Range("G8:G" & lr + 7)
    
    'Runnning for loop to check all available cells
    For Each IpData In DataRange
    For iCnt = 1 To Len(IpData.Value)
        
        If Not Mid(IpData.Value, iCnt, 1) Like "[0-9A-Z]" Then
            IpData.Interior.ColorIndex = 45
            
        ElseIf Len(IpData) <> 11 Then
            IpData.Interior.ColorIndex = 45
            
            ctr = ctr + 1
        Exit For
        End If
        
    Next iCnt
    Next IpData
      
        If ctr > 0 Then
            MsgBox "Unwanted Character / Less than 11 digits fould in IFSC Code", vbExclamation, "Wrong IFSC Code"
            Exit Sub
        End If

Sheet3.Protect ("Rudra@130357")
'-----------------------------------------------------------------------------------------------------------------------------------
    Call Creat_xlsx

    Call Creat_xls

    MsgBox "Bank file is generated successfully in Output Folder", vbInformation, "Conversion Success"
    
 End Sub
  
Sub Creat_xlsx()
'Below code will create required Bank Files on Output Folder
    
    Sheet3.Copy

    Cells.Copy
    
    Application.CutCopyMode = False

    Set WbNew = ActiveWorkbook

    WbNew.SaveAs ThisWorkbook.Path & "\Output\" & Format(Date, "DDMMYYYY") & Format(Time, "HHMMSS") & ".xlsx", 51
    
    WbNew.Close True

End Sub

Sub Creat_xls()
'Below code will create required Bank Files on Output Folder

    Sheet3.Unprotect ("Rudra@130357")

    Sheet3.Rows("1:2").Delete
    
    Sheet3.Protect ("Rudra@130357")
    
    Sheet3.Copy

    Cells.Copy
    
    Application.CutCopyMode = False
    
    Set WbNew = ActiveWorkbook
    
    WbNew.SaveAs ThisWorkbook.Path & "\Output\" & Format(Date, "DDMMYYYY") & Format(Time, "HHMMSS") & ".xls", 56
    
    WbNew.Close True
    
End Sub

Code is fulfilling my requirement, but I want code should highlight all error at one time. (currently code is highlighting Account number error first, if error doesn't found it is highlighting IFSC code errors.)

 

[SamarthSalunkhe]

In your previous post, you posted your code, but only as far down as the "End If".
Please post ALL the code in that procedure, all the way down to the "End Sub" line.
I need to see what is after what you already posted, down to the end of the procedure.

Hi @Joe4

Got the solution, Thank You for your time support and suggestions.

Final code is as below, if anything I have updated wrong, please confirm.

Option Explicit

Dim WbNew As Workbook
 
Sub Make_File()

'Below code will stop process when data is not imported

    If Sheet3.Range("A1").Value = "" Then
    MsgBox "Please import data first and then Generate File", vbExclamation, "Conversion Failed"
   
    Exit Sub
End If
'-----------------------------------------------------------------------------------------------------------------------------------

    'Variable Declaration
    Dim iCnt As Integer
    Dim IpData As Range, DataRange As Range
    Dim sData As String, sTmp As String
    Dim lr As Long
    Dim ctr As Long

Sheet3.Unprotect ("Rudra@130357")

'Below code will find Unwanted Characters in Account Number Column

    lr = Sheet3.Range("F" & Rows.Count).End(xlUp).Row
   
    'Create Object for Selected Range
    Set DataRange = Sheet3.Range("F8:F" & lr + 7)
   
    'Runnning for loop to check all available cells
    For Each IpData In DataRange
    For iCnt = 1 To Len(IpData.Value)
       
        If Not Mid(IpData.Value, iCnt, 1) Like "[0-9A-Z]" Then
            IpData.Interior.ColorIndex = 45
            ctr = ctr + 1
        Exit For
        End If
    Next iCnt
    Next IpData
'-----------------------------------------------------------------------------------------------------------------------------------
'Below code will find Unwanted Characters in IFSC Code Column
 
    lr = Sheet3.Range("G" & Rows.Count).End(xlUp).Row
   
    'Create Object for Selected Range
    Set DataRange = Sheet3.Range("G8:G" & lr + 7)
   
    'Runnning for loop to check all available cells
    For Each IpData In DataRange
    For iCnt = 1 To Len(IpData.Value)
       
        If Not Mid(IpData.Value, iCnt, 1) Like "[0-9A-Z]" Then
            IpData.Interior.ColorIndex = 45
           
        ElseIf Len(IpData) <> 11 Then
            IpData.Interior.ColorIndex = 45
           
            ctr = ctr + 1
        Exit For
        End If
       
    Next iCnt
    Next IpData
     
        If ctr > 0 Then
            MsgBox "Remove highlighted errors and Generate File again", vbExclamation, "Wrong A/c or IFSC"
            Exit Sub
        End If

Sheet3.Protect ("Rudra@130357")
'-----------------------------------------------------------------------------------------------------------------------------------
    Call Creat_xlsx

    Call Creat_xls

    MsgBox "Bank file is generated successfully in Output Folder", vbInformation, "Conversion Success"
   
 End Sub
 
Sub Creat_xlsx()
'Below code will create required Bank Files on Output Folder
   
    Sheet3.Copy

    Cells.Copy
   
    Application.CutCopyMode = False

    Set WbNew = ActiveWorkbook

    WbNew.SaveAs ThisWorkbook.Path & "\Output\" & Format(Date, "DDMMYYYY") & Format(Time, "HHMMSS") & ".xlsx", 51
   
    WbNew.Close True

End Sub

Sub Creat_xls()
'Below code will create required Bank Files on Output Folder

    Sheet3.Unprotect ("Rudra@130357")

    Sheet3.Rows("1:2").Delete
   
    Sheet3.Protect ("Rudra@130357")
   
    Sheet3.Copy

    Cells.Copy
   
    Application.CutCopyMode = False
   
    Set WbNew = ActiveWorkbook
   
    WbNew.SaveAs ThisWorkbook.Path & "\Output\" & Format(Date, "DDMMYYYY") & Format(Time, "HHMMSS") & ".xls", 56
   
    WbNew.Close True
   
End Sub