Conditional Formatting, Delete Row with "" in A:A, Insert column

S

soccerjon1013

New Member
Joined
Apr 16, 2012
Messages
48
I should mention first, i'm new to the VBA and trying to learn, please excuse any of my rookie mistakes, and I greatly appreciate all of the help/input anyone is able to provide.

I have a report that we run daily. It involves pasting data from a database, removing rows with no Call Disposition, highlight row yellow from A-AL if Call Disposition is "Completed Survey", if any row in Q10 = "Yes" then insert column between AC and AD. There is a group of cells on tab "Totals Formatted" B21:b23 that reference the first tab "Daily Report Total" column AD. Since the column is inserted, it will change the reference from AD to AE. We would need to replace the reference in those cells to AD.

The conditional formatting would be a nice touch, but if I could have help with the rest of this, it would be help much.

I put in AL1 the formula =countif(AC:AC,"Yes")

There issues I'm having are as follow:
  1. Where it searches through A:A for cells with no call disposition, it looks like it is not selecting them as blank, perhaps I need to be looking for "" instead? What would be the right way to do so?
  2. It's not adding a column
  3. The steps to replace AE:AE with AD:AD give the formula a #REF value
  4. I have no idea where to start with the conditional formatting

Code: 
Sub Install_Survey()'
' Install_Survey Macro
' Macro recorded 1/10/2015
'
' Keyboard Shortcut: Ctrl+q
'
' Sort 1st
    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("AC2") _
        , Order2:=xlDescending, Key3:=Range("AD2"), Order3:=xlDescending, Header _
        :=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
        xlSortNormal
    
   ' Delete Empty Disposition
   Columns("A:A").Select
   Selection.SpecialCells(xlCellTypeBlanks).Select
   Selection.EntireRow.Delete
' Sort 2nd
    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("AC2") _
        , Order2:=xlDescending, Key3:=Range("AD2"), Order3:=xlDescending, Header _
        :=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
        xlSortNormal
' Insert column if any issues
' Search for Yes for Q10


If AL1 > 0 Then
    Columns(29).Select
    Selection.Insert Shift:=xlToRight
    End If
If AL1 > 0 Then
' Replace Reason counts on last tab
    Sheets("Totals Formatted").Select
    Range("B21:B33").Select
    Selection.Replace What:="AE:AE", Replacement:="AD:AD", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="AE:AE", Replacement:="AD:AD", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Sheets("Daily Report Total").Select
    Range("A2").Select
    End If
End Sub
 
Sort by date Sort by votes
1. There are invisible dirts at A127:A132 in sheets "Daily Report Total" that's why the code doesn't delete that rows; select that range and type Delete to fix it
Click to expand...

As another option to the manual selection you could try the code below

Code: 
 With Sheets("Daily Report Total").Columns("A:A")
        .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, FieldInfo:=Array(1, 1)
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 End With
 
Upvote 0

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
You were right, I changed it to the correct one, 30. Here is the completed code and is working now.

Code: 
Sub Install_Survey() '
' Install_Survey Macro
' Macro recorded 1/10/2015
'
' Keyboard Shortcut: Ctrl+q
'
' Delete Blanks
 With Sheets("Daily Report Total").Columns("A:A")
        .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, FieldInfo:=Array(1, 1)
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 End With


' // Delete Empty Disposition
  Dim LastRow As Long, LastColumn As Long
  With Sheets("Daily Report Total")
   LastRow = .UsedRange.Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
   LastColumn = .UsedRange.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
    On Error Resume Next
    .Range("A1", .Range("A" & LastRow)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete


'// Sort
    With .Range(.Cells(2, "A"), .Cells(LastRow, LastColumn))
     .Sort Key1:=.Range("A2"), Order1:=xlAscending, Key2:=.Range("AC2") _
        , Order2:=xlDescending, Key3:=.Range("AD2"), Order3:=xlDescending, Header _
        :=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
        xlSortNormal
    End With
  End With


' Insert column if any issues
' Search for Yes for Q10


  If Sheets("Daily Report Total").Range("AL1").Value > 0 Then
     Sheets("Daily Report Total").Columns(30).Insert
    'Replace Reason counts on last tab
    With Sheets("Totals Formatted").Range("B21:B33")
     .Replace What:="AE", Replacement:="AD", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    End With
  End If


End Sub
 
Upvote 0
Are you sure you need all that code?

Code: 
 With Sheets("Daily Report Total").Columns("A:A")
        .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, FieldInfo:=Array(1, 1)
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 End With

should be replacing

Code: 
With Sheets("Daily Report Total")
   LastRow = .UsedRange.Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
   LastColumn = .UsedRange.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
    On Error Resume Next
    .Range("A1", .Range("A" & LastRow)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Does it not?
Although you might want to put in the on error resume next line
 
Upvote 0
Try (untested)

Rich (BB code): 
Sub Install_Survey()    '
' Install_Survey Macro
' Macro recorded 1/10/2015
'
' Keyboard Shortcut: Ctrl+q
'
' Delete Blanks
    Dim LastRow As Long, LastColumn As Long
    With Sheets("Daily Report Total")
        LastRow = .UsedRange.Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
        LastColumn = .UsedRange.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column

        With .Columns("A:A")
            .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, FieldInfo:=Array(1, 1)
            On Error Resume Next
            .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            On Error GoTo 0
        End With

        With .Range(.Cells(2, "A"), .Cells(LastRow, LastColumn))
            .Sort Key1:=.Range("A2"), Order1:=xlAscending, Key2:=.Range("AC2") _
                , Order2:=xlDescending, Key3:=.Range("AD2"), Order3:=xlDescending, Header _
                                                                                 :=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
                  xlSortNormal
        End With



        ' Insert column if any issues
        ' Search for Yes for Q10


        If .Range("AL1").Value > 0 Then
            .Columns(30).Insert
            'Replace Reason counts on last tab
            With Sheets("Totals Formatted").Range("B21:B33")
                .Replace What:="AE", Replacement:="AD", LookAt:=xlPart, _
                         SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
                         ReplaceFormat:=False
            End With
        End With
    End If


End Sub

or if I'm reading it right (again untested)

Rich (BB code): 
Sub Install_Survey()    '
' Install_Survey Macro
' Macro recorded 1/10/2015
'
' Keyboard Shortcut: Ctrl+q
'
' Delete Blanks
    Dim LastRow As Long, LastColumn As Long
    With Sheets("Daily Report Total")
        LastRow = .UsedRange.Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
        LastColumn = .UsedRange.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column

        With .Columns("A:A")
            .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, FieldInfo:=Array(1, 1)
            On Error Resume Next
            .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            On Error GoTo 0
        End With

        With .Range(.Cells(2, "A"), .Cells(LastRow, LastColumn))
            .Sort Key1:=.Range("A2"), Order1:=xlAscending, Key2:=.Range("AC2") _
                , Order2:=xlDescending, Key3:=.Range("AD2"), Order3:=xlDescending, Header _
                                                                                 :=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
                  xlSortNormal
        End With



        ' Insert column if any issues
        ' Search for Yes for Q10


        If .Range("AL1").Value > 0 Then .Columns(30).Insert
            'Replace Reason counts on last tab
            Sheets("Totals Formatted").Range("B21:B33").Replace What:="AE", Replacement:="AD", LookAt:=xlPart, SearchOrder:=xlByColumns

        End With
  


End Sub
 
Last edited:
Upvote 0
Osvaldo Palmeiro said:
1. There are invisible dirts at A127:A132 in sheets "Daily Report Total" that's why the code doesn't delete that rows; select that range and type Delete to fix it

2. I'm confused if you want insert a column at column 29:
a) if AL1>0 as is in your original code or
b) if there's any "Yes" in column "Q" or
c) Q10 = "Yes" (if this is the criteria it should be before or after sort the
table?)
I left the first condition but I think that not makes sense.

3. See if the code below works like you need, except for the doubt above, and then we'll work on Conditional Formatting ( highlight row yellow from A-AL if Call Disposition is "Completed Survey")
Click to expand...

It looks like poor explaining on my part, I'm sorry. I changed the code to column 30 to input the new column
2a and 2b - either is possible, as I'm not so well at this, I just used if AL1>0 to see if there is a "Yes" in column AC
(my reference to Q10 was not actually a cell reference, but a value at AC1. Below AC1 is the results to question 10 on the survey being "Yes" or "No".
 
Upvote 0
MARK858 said:
Try (untested)

Rich (BB code): 
Sub Install_Survey()    '
' Install_Survey Macro
' Macro recorded 1/10/2015
'
' Keyboard Shortcut: Ctrl+q
'
' Delete Blanks
    Dim LastRow As Long, LastColumn As Long
    With Sheets("Daily Report Total")
        LastRow = .UsedRange.Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
        LastColumn = .UsedRange.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column

        With .Columns("A:A")
            .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, FieldInfo:=Array(1, 1)
            On Error Resume Next
            .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            On Error GoTo 0
        End With

        With .Range(.Cells(2, "A"), .Cells(LastRow, LastColumn))
            .Sort Key1:=.Range("A2"), Order1:=xlAscending, Key2:=.Range("AC2") _
                , Order2:=xlDescending, Key3:=.Range("AD2"), Order3:=xlDescending, Header _
                                                                                 :=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
                  xlSortNormal
        End With



        ' Insert column if any issues
        ' Search for Yes for Q10


        If .Range("AL1").Value > 0 Then
            .Columns(30).Insert
            'Replace Reason counts on last tab
            With Sheets("Totals Formatted").Range("B21:B33")
                .Replace What:="AE", Replacement:="AD", LookAt:=xlPart, _
                         SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
                         ReplaceFormat:=False
            End With
        End With
    End If


End Sub

or if I'm reading it right (again untested)

Rich (BB code): 
Sub Install_Survey()    '
' Install_Survey Macro
' Macro recorded 1/10/2015
'
' Keyboard Shortcut: Ctrl+q
'
' Delete Blanks
    Dim LastRow As Long, LastColumn As Long
    With Sheets("Daily Report Total")
        LastRow = .UsedRange.Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
        LastColumn = .UsedRange.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column

        With .Columns("A:A")
            .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, FieldInfo:=Array(1, 1)
            On Error Resume Next
            .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            On Error GoTo 0
        End With

        With .Range(.Cells(2, "A"), .Cells(LastRow, LastColumn))
            .Sort Key1:=.Range("A2"), Order1:=xlAscending, Key2:=.Range("AC2") _
                , Order2:=xlDescending, Key3:=.Range("AD2"), Order3:=xlDescending, Header _
                                                                                 :=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
                  xlSortNormal
        End With



        ' Insert column if any issues
        ' Search for Yes for Q10


        If .Range("AL1").Value > 0 Then .Columns(30).Insert
            'Replace Reason counts on last tab
            Sheets("Totals Formatted").Range("B21:B33").Replace What:="AE", Replacement:="AD", LookAt:=xlPart, SearchOrder:=xlByColumns

        End With
  


End Sub
Click to expand...

Your 2nd one did work
 
Upvote 0
I have 1 more issue that happened as I started to do more with this. I added a macro to first import the data from access, so my formula in AL1 is no longer going to work, how could I modify this to look for "Yes" in AC instead?
 
Upvote 0
soccerjon1013 said:
I have 1 more issue that happened as I started to do more with this. I added a macro to first import the data from access, so my formula in AL1 is no longer going to work, how could I modify this to look for "Yes" in AC instead?
Click to expand...


Scratch that, I was able to import the data over the existing cells instead of inserting them.
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question
Macro not working after adding two new items
Replies
4
Views
154
myall_blues
myall_blues
C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
282
Coco1
C
D
  • Solved
Use the same macro on a weekly file which contains date info
Replies
1
Views
282
John_w
J
S
  • Question
Worksheets Buttons Update
Replies
0
Views
431
sharpeye
S
R
  • Question
Formatting using VBA
Replies
0
Views
433
RandyD123
R

Forum statistics

Threads
1,215,831
Messages
6,127,142
Members
449,362
Latest member
Bracelane

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top