Macro for Finding Blank Cells in Row and Deleting Part of Column

[FrenchCelt]

Hello,

I want to create a macro that looks for blank cells in row 12 of a daily Excel-based report I generate. When it finds one, I want to select every cell in that column starting with row 11 and going down until the same row as a cell in Column A that contains the text "Total Unapproved Indirect Labor" and then deleting and shifting cells left. This range of rows will vary from spreadsheet to spreadsheet, and the number of columns will also vary, but these constraints are constant.

Can anyone help?

 

[Joe4]

How do we determine how many columns in row 12 we need to check?
At some point, all the columns after a certain point will be blank.
Are we just looking as far as the last populated column in row 12, or should we use a different row to determine where the last column to search is?

 

[FrenchCelt]

How do we determine how many columns in row 12 we need to check?
At some point, all the columns after a certain point will be blank.
Are we just looking as far as the last populated column in row 12, or should we use a different row to determine where the last column to search is?

Ah yes, this will be determined by the values in row 11 starting with B11.

 

[Joe4]

Try this code:

Sub MyDeleteMacro()

    Dim fndStr As String
    Dim lr As Long
    Dim lc As Long
    Dim c As Long

    Application.ScreenUpdating = False

'   Enter value to find in column A
    fndStr = "Total Unapproved Indirect Labor"
    
'   Find last row (row in column A with fndStr value)
    On Error GoTo err_chk
    lr = Columns("A:A").Find(What:=fndStr, After:=Range("A1"), _
        LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
    On Error GoTo 0
        
'   Find last populated column in row 11
    lc = Cells(11, Columns.Count).End(xlToLeft).Column
        
'   Loop through all columns, starting with column B, in row 12 backwards
    For c = lc To 2 Step -1
'       Check to see if column in row 12 is blank
        If Cells(12, c) = "" Then
'           Delete blank cells in that column
            Range(Cells(11, c), Cells(lr, c)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
        End If
    Next c
    
    Application.ScreenUpdating = True
        
    Exit Sub
    

'   Error handling code
err_chk:
    If Err.Number = 91 Then
        MsgBox "Cannot find " & Chr(34) & fndStr & Chr(34) & " in column A", vbOKOnly, "ERROR!"
    Else
        MsgBox Err.Number & ": " & Err.Description
    End If
    
    Application.ScreenUpdating = True

End Sub

 

[FrenchCelt]

Try this code:

Thanks for helping. This worked to an extent, but it left me with some formatting issues. I have an example of what the worksheet looks like before the macro and what it should look like after.

Before:

https://drive.google.com/open?id=12_9MUTnkxpClKtlV47RwPnij2udoClyo

After:

https://drive.google.com/open?id=1kFnwg1Qus-q6L6gF_6-91Q_k2Jk2ryGN

As you can see, afterward the top section should align with the bottom section in terms of the usernames. Your code leaves the user sections out of alignment.

 

[Joe4]

I do not have the ability to download or images from my current location (workplace security policy prevents it). I may be able to look at it from a different computer tonight.

Is all the data in the correct place though?

 

[FrenchCelt]

I do not have the ability to download or images from my current location (workplace security policy prevents it). I may be able to look at it from a different computer tonight.

Is all the data in the correct place though?

Yes.

 

[Joe4]

OK, so it sounds like the code I posted did answered the original question (formatting wasn't part of the original question).
I have no idea what kind of formatting you are dealing with, until I look at your files.

 

[FrenchCelt]

I think I figured it out. Not every cell in the range I want deleted is blank...but the cells in row 12 that are blank identify the columns where I want the range deleted. So I removed "SpecialCells(xlCellTypeBlanks)" from your code and I think it did the trick. I only had time to do a quick trial before I had to leave work, so I can't be sure, but everything looked correct. I'll let you know for sure tomorrow morning when I get a chance to take a closer look.

 

[FrenchCelt]

Yes, I confirmed that the code now works as intended by making that edit. Thanks for your help!