2

The point of this code is to take user inputs from a "Remove Flags" tab in which the user puts an item number and what program it belongs to, filters the "Master List" tab by the item number and the program, then match the name of the flag to the column and delete the flag. However the offset is not working. It is instead deleting the header. When I step through it everything works fine until the line I marked with '*******.

I am fairly new to VBA and am self taught so any and all help is greatly appreciated. Thank you very much for your time.

EDIT: Removed "On Error Resume Next" and fixed some spelling errors. Current issue is with rng not having >1 rows when it is filtered and definitely has two rows (one row is the header, one row is the returned data.)

Sub RemoveFlag()
Dim cel As Range
Dim rg As Range
Dim d As Double
Dim i As Integer
Dim m As Integer
Dim n As Integer
Dim rng As Range
Dim wsMaster As Worksheet
Dim wsFlag As Worksheet
Set wsMaster = Worksheets("Master List")
Set wsFlag = Worksheets("Remove Flags")
i = 6

'If there is no data. Do nothing.
If wsFlag.Range("C6") = "" Then
    wsFlag.Activate
Else
    Application.ScreenUpdating = False

'Add Leading zeroes
wsFlag.Activate
Set rg = Range("C6")
Set rg = Range(rg, rg.Worksheet.Cells(Rows.Count, rg.Column).End(xlUp))
rg.NumberFormat = "@"
For Each cel In rg.Cells
If IsNumeric(cel.Value) Then
    d = Val(cel.Value)
    cel.Value = Format(d, "000000000000000000") 'Eighteen digit number
End If
Next

'Clear all the filters on the Master List tab.
    wsMaster.Activate
If wsMaster.AutoFilterMode = True Then
    wsMaster.AutoFilterMode = False
End If

'Loop through all lines of data
    Do While wsFlag.Cells(i, 3).Value <> ""
'Filter by the SKU number
wsMaster.Range("A1").AutoFilter Field:=4, Criteria1:=wsFlag.Cells(i, 3).Value
'Filter by the Program
    wsMaster.Range("A1").AutoFilter Field:=2, Criteria1:=wsFlag.Cells(i, 2).Value
'If the filter is not empty find the column of the flag
Set rng = wsMaster.UsedRange.SpecialCells(xlCellTypeVisible)

If (rng.Rows.Count > 1) Then
    wsMaster.Range("A1:Z1").Find(wsFlag.Cells(i, 4), LookIn:=xlValues).Activate
    n = ActiveCell.Column
    Sheets("Master List").Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).Select
    m = ActiveCell.Row
    Cells(m, n) = ""
    wsFlag.Activate
    wsFlag.Range(Cells(i, 2), Cells(i, 4)).ClearContents
Else
    wsFlag.Activate
    wsFlag.Range(Cells(i, 2), Cells(i, 4)).Copy
    wsFlag.Range("F4").End(xlDown).Offset(1, 0).Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues
    wsFlag.Range(Cells(i, 2), Cells(i, 4)).ClearContents
End If
    wsMaster.Activate
    wsMaster.AutoFilterMode = False
i = i + 1
Loop

'Make sure the entire Master List tab is not highlighted and pull the 'highlighted cell' to A1 in both tabs.
    wsMaster.Activate
    wsMaster.Range("A1").Activate

wsFlag.Activate
Range("A1").Activate

'Unfreeze the screen
Application.ScreenUpdating = True

End If
End Sub
21
  • 2
    Do you have sheets called "Master List", "Master<spaces>List" and "Maser List"? Commented Feb 16, 2017 at 15:19
  • 1
    Your code references all those sheet names - I'm guessing you have one called Master List and the others are typos. Also, does your FIND line actually find anything? If not your ActiveCell won't move and it n will be whatever row is active before the find command. Commented Feb 16, 2017 at 15:22
  • 4
    This line "activesheet.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).Select" resolves into an error and is ignored, so you don't offset down off the header row and set m to that row, hence clearing the header. You left "on error resume next" on so wasn't made aware of the error, it's bad practice and leads to problems like this. Commented Feb 16, 2017 at 15:24
  • 3
    @DarrenBartrup-Cook it will be masking the incorrect worksheet references also. Commented Feb 16, 2017 at 15:26
  • 3
    How to avoid using Select and Activate in Excel VBA macros Commented Feb 16, 2017 at 15:30

2 Answers 2

2

As @Zerk suggested, first set two Worksheet variables at top of code:

Dim wsMaster As Worksheet
Dim wsRemoveFlags As Worksheet

Set wsMaster = Worksheets("Master List")
Set wsRemoveFlags = Worksheets("Remove Flags")

Then replace all other instances of Worksheets("Master List") with wsMaster and Worksheets("Remove Flags") with wsRemoveFlags.

Sign up to request clarification or add additional context in comments.

1 Comment

I appreciate this suggestion and agree that it cleans up the code significantly, but since the code is still not functioning as intended I'm not going to accept this as the solution.
1

Sometimes it's easier to just loop through your rows and columns. Something like the following:

Replace everything between:

Do While wsFlag.Cells(i, 3).Value <> ""
   ...
Loop

with:

Do While wsFlag.Cells(i, 3).Value <> "" 
    Dim r As Long  ' Rows
    Dim c As Long  ' Columns
    Dim lastRow As Long
    Dim found As Boolean

    lastRow = wsMaster.Cells.SpecialCells(xlLastCell).Row
    found = False

    For r = 2 To lastRow ' Skipping Header Row
        ' Find Matching Program/SKU
        If wsMaster.Cells(r, 2).Value = wsFlag.Cells(i, 2).Value _
        And wsMaster.Cells(r, 3) = wsFlag.Cells(i, 3).Value Then
            ' Find Flag in Row
            For c = 1 To 26   ' Columns A to Z
                 If wsMaster.Cells(r, c) = wsFlag.Cells(i, 4) Then
                     ' Found Flag
                     wsMaster.Cells(r, c) = ""
                     found = True
                     Exit For ' if flag can be in more than one column, remove this.
                 End If
            Next 'c
        End If
    Next 'r

    If Not found Then
        ' Here is where you need to put code if Flag wsFlag.Cells(i, 4) not found.
    End If
Loop

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.