Solved

VBA - Identify duplicates and Blanks

Posted on 2014-04-24
10
319 Views
Last Modified: 2014-04-25
Hello,

I would like to create a VBA script in Excel (2013).

I would like the script to work down a worksheet (called 'PM') from row 4 (in column A) downwards until the end of the list and look for two conditions:

The cell in column C of the same row is blank or;
The value in column C is not duplicated elsewhere in column C at all on this worksheet.

If the condition(s) are met above I would like the row number on which the condition was picked up and quick outline of which issue was identified above to be put on another worksheet called errors!

I know  a little about VBA scripts - could someone start me off in the right direction as I have not picked one up in a little while.

thanks,

GISVPN
0
Comment
Question by:gisvpn
  • 4
  • 4
  • 2
10 Comments
 
LVL 22

Expert Comment

by:rspahitz
Comment Utility
Although a VBA solution is viable, I usually avoid them if possible because they are more prone to errors than Excel formula solutions such as the one below.  The main reason to use VBA is that the formulas would be too complex or that you want to repeat a process that is difficult to duplicate in a formula (like copy/paste)

So to create a formula to solve your problem, go to the errors worksheet and put this in cell A1:

=MATCH(PM!C1,INDIRECT("PM!A"&(ROW()+1)&":A10000"),0)+ROW()

Then put this in B1:
=IF(ISNA(A1),IF(PM!C1="","blank",""),A1)

If you copy these down to match the number of entries you have in your PM worksheet, then you should see the word blank wherever there was a blank in column C and a number wherever any number was found below it in the list.  You may want to hide column A in the errors tab since it's a "work" column.

If this is not sufficient, I can write something in VBA for you.
0
 

Author Comment

by:gisvpn
Comment Utility
Hi rspahitz,

Thank you for posting! I unfortunately have to use some VBA on this project ;) but thank you for the suggestion above!

GISVPN
0
 
LVL 68

Assisted Solution

by:Qlemo
Qlemo earned 200 total points
Comment Utility
Something similar to
Dim err as Range
set err = [Errors!A1]
For Each c in Range([A4], [A4].End(xlDown))
  If c.Offset(,2).Value = "" Then
    err.Offset(,0) = c.Row
    err.Offset(,1) = "empty"
    set err = err.Offset(1,)
  ElseIf [C:C].Find(c, c, xlValues, xlWhole, xlByRows, xlNext).Address = c.Address Then
    err.Offset(,0) = c.Row
    err.Offset(,1) = "unique"
    set err = err.Offset(1,)
  End If
Next

Open in new window

0
 

Author Comment

by:gisvpn
Comment Utility
Hi Qlemo,

Could we simplify the question at all, this will make it easier for me to get back into things?

I would just like a loop which would run down the A column (as long as there are values in it) and where the C column (on the same row) has a blank cell it will put a message on the Errors Worksheet (which includes the row number the error was picked up on and a short bit of text (something like Blank Cell in C identified)

;)

GISVPN
0
 
LVL 68

Expert Comment

by:Qlemo
Comment Utility
If you remove lines 8 to 11, you will have exactly that simplification.
The For Each will go thru all A's, starting in row 4, look for the value in C, and if empty writes to the Errors sheet, with the row number in A, and text in B.
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:gisvpn
Comment Utility
ok thank you - can I ask specifically what this is defining:

set err = [Errors!A1]

and will this move on the row one more?

set err = err.Offset(1,)
0
 
LVL 68

Expert Comment

by:Qlemo
Comment Utility
[Sheet!Cell] is a complete cell address, so [Errors!A1] is the first cell of the Errors sheet.

We need a SET here because we handle the object (which is a cell), and not the value of it. err =[Errors!A1] is the same as err = [Errors!A1].Value, so the variable would contain what is written in that cell (probably nothing).

The first SET says "store the object in this var", and the second "replace the var with the object one row down". Yes, that is just moving the range (which is a cell here) down one row, and next run will write into Errors!A2.
0
 

Author Comment

by:gisvpn
Comment Utility
ok thanks that has helped a lot. How do I set the worksheet where this part looks at the A4 downwards ?

For Each c in Range([A4], [A4].End(xlDown))

Can I do something like sheets("name").select ?
0
 
LVL 68

Expert Comment

by:Qlemo
Comment Utility
Set the sheet active, selecting will not do. Or includ the sheet name in the square  brackets, like witb the Errors sheet.
0
 
LVL 22

Accepted Solution

by:
rspahitz earned 300 total points
Comment Utility
The previous code is good, but I prefer to use more pure VB code with this (rather than the Excel functions of ".End")

This should work too:

Sub FindErrors()
    Dim PMRow As Integer
    Dim ErrorRow As Integer
    Dim ACellValue As String
    Dim CCellValue As String
    
    PMRow = 4
    ErrorRow = 1
    Sheets("Errors").Cells.ClearContents
    Do
        ACellValue = Sheets("PM").Cells(PMRow, 1).Value
        If ACellValue = "" Then
            Exit Do
        End If
        
        CCellValue = Sheets("PM").Cells(PMRow, 3).Value
        If CCellValue = "" Then
            Sheets("Errors").Cells(ErrorRow, 1) = PMRow
            Sheets("Errors").Cells(ErrorRow, 2) = "blank"
            ErrorRow = ErrorRow + 1
        ElseIf CheckDuplicate(CCellValue) Then
            Sheets("Errors").Cells(ErrorRow, 1) = PMRow
            Sheets("Errors").Cells(ErrorRow, 2) = "duplicate (" & CCellValue & ")"
            ErrorRow = ErrorRow + 1
        End If
        
        PMRow = PMRow + 1
    Loop
End Sub

Private Function CheckDuplicate(ValuetoCheck As String) As Boolean
    Dim ValueCount As Integer
    Dim PMRow As Integer
    Dim ACellValue As String
    Dim CCellValue As String
    Dim DuplicateFound As Boolean
    
    DuplicateFound = False
    PMRow = 4
    Do
        ACellValue = Sheets("PM").Cells(PMRow, 1).Value
        If ACellValue = "" Then
            Exit Do
        End If
        
        CCellValue = Sheets("PM").Cells(PMRow, 3).Value
        If CCellValue = ValuetoCheck Then
            ValueCount = ValueCount + 1
            If ValueCount > 1 Then
                DuplicateFound = True
            End If
        End If
        
        PMRow = PMRow + 1
    Loop
    
    CheckDuplicate = DuplicateFound
End Function

Open in new window


run the macro, FindErrors, and it will put the errors in the errors tab
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Displaying an arrayList in a listView using the default adapter is rarely the best solution. To get full control of your display data, and to be able to refresh it after editing, requires the use of a custom adapter.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now