Select only blank cells in range with macro - Excel 2007

[EricL89]

I've got a data range across A:K, with headers in row 3 (all data entries beginning in row 4). I'm trying to run a macro which takes the prospect's name in A, and tells me which cells in C:K, if any, are blank for each producer's initials found in B. For example:

If A4:K4 are all filled, it goes to the next row. For row 5, let's say F5 and J5 are the only blank cells. At this point, A5 will be copied & pasted onto a new sheet, and the headers for the blank cells will be copied & pasted in the cells next to where A5 was pasted. This process will work its way down the spreadsheet for each row with one producer's initials, then once it reaches the bottom it will start again with another producer.

I've already got the code to create a new sheet, and to copy the headers of the blank cells. I'm only having trouble telling the code to find any blank cells within the range C:K for the active row, then copying any & all headers of the blank cells.

Right now this is what I have in terms of copying & pasting the headers on a new sheet.

Sub ToDoList()


Dim producer As String
Dim prospect As Long
Dim lngRows As Long
Dim blankCol As Long


Application.ScreenUpdating = False




        Worksheets.Add
        
        ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
        ActiveSheet.Name = ("To Do List")
        
        ThisWorkbook.Sheets("Master").Activate
        
        Range("a4").Select
                       
        Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0))
        
            prospect = ThisWorkbook.Sheets("To Do List").Cells(Rows.Count, 1).End(xlUp).Row + 1
            blankCol = ThisWorkbook.Sheets("To Do List").Cells(Columns.Count, 1).End(xlUp).Column + 1
            lngRows = ActiveCell.Row
            producer = ActiveCell.Offset(0, 1).Value
            
        
            ThisWorkbook.Sheets("To Do List").Activate
            Range("a1").Select
            ActiveCell.Font.Bold = True
            ActiveCell = "JOHN SMITH'S INCOMPLETES"
            ThisWorkbook.Sheets("Master").Activate
            Rnage("a4").Select
                        
            If producer = "JS" Or producer = "js" Then
            
                ActiveCell.Copy
                ThisWorkbook.Sheets("To Do List").Activate
                Cells(prospect, 1).Select
                ActiveCell.PasteSpecial
                Range("A" & prospect).Select
                ThisWorkbook.Sheets("Master").Select
                                               
                    If IsEmpty(ActiveCell.Offset(0, 2)) Or IsEmpty(ActiveCell.Offset(0, 3)) Or IsEmpty(ActiveCell.Offset(0, 4)) Or IsEmpty(ActiveCell.Offset(0, 5)) Or IsEmpty(ActiveCell.Offset(0, 6)) Or IsEmpty(ActiveCell.Offset(0, 7)) Or IsEmpty(ActiveCell.Offset(0, 8)) Or IsEmpty(ActiveCell.Offset(0, 9)) Or IsEmpty(ActiveCell.Offset(0, 10)) Then
                                     
                    ActiveCell.Offset(-lngRows + 3, 2).Copy              \\*this would be if column C was blank, but I need something to copy all headers of blank cells*\\
                    ThisWorkbook.Sheets("To Do List").Activate
                    Cells(prospect, blankCol).Select
                    ActiveCell.PasteSpecial
                    Range("A" & prospect).Select
                    ThisWorkbook.Sheets("Master").Select
                    
                    
                    End If
                
                    
                                        
                    ActiveCell.Offset(1, 0).Select
                    
                End If
           
        
           Loop




End Sub

This is just for the first producer (not a real name), but it should be a simple matter of repeating for each set of initials.

Please let me know if you've got any ideas. Thanks!

Eric

 

[Andrew Poulsom]

You can use Range.SpecialCells(xlCellTypeBlanks) to return the blank cells in Range.

 

[EricL89]

You can use Range.SpecialCells(xlCellTypeBlanks) to return the blank cells in Range.

Thanks Andrew! Could you let me know where & how to incorporate it? I figured it should be added after the long "If IsEmpty" chain, above "ActiveCell.Offset(-lngRows + 3, 2).Copy".

I entered it as "Range.SpecialCells(xlCellTypeBlanks).Select", hoping it would select all of the blank cells and got an error message saying "compile error: argument not optional".

I'm still fairly new to macros, so I'm not sure how to proceed here.

Is there a simple way to say: "For each row, copy headers of all empty cells"?

 

[Andrew Poulsom]

See if you can adapt this:

Sub Test()
    Dim ShNew As Worksheet
    Dim LastRow As Long
    Dim r As Long
    Dim NextRow As Long
    Dim Blanks As Range
    Set ShNew = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    ShNew.Name = "To Do List"
    With Worksheets("Master")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        For r = 4 To LastRow
            On Error Resume Next
            Set Blanks = .Range("C" & r & ":K" & r).SpecialCells(xlCellTypeBlanks)
            If Err = 0 Then
                NextRow = NextRow + 1
                .Range("A" & r).Copy ShNew.Range("A" & NextRow)
                .Range(Replace(Blanks.Address, r, 3)).Copy ShNew.Range("B" & NextRow)
            Else
                Err.Clear
                On Error GoTo 0
            End If
        Next r
    End With
End Sub

 

[EricL89]

Yes! This works great! I do need some help making some tweaks though. Because this runs from the new worksheet, I'm having trouble telling it to only do it for certain producer initials (i.e. If producer = "JS" Or producer = "js" Then). I need it to run through for one producer's initials, then go through again from the top for another, and another, and so on.

I'm going to keep playing with it to try to figure it out, but I'd really appreciate your help once more. Thanks again!

 

[Andrew Poulsom]

Couldn't you copy columns A and B and sort by supplier afterwards?

 

[EricL89]

I was able to make it work, just took a little trial-and-error. Thanks again for your help!