Changing a Row-Deleting VBA based on Department Number to a List

[jassybun]

Hello! I was wondering if would be possible to refer to a List in the second tab of a worksheet instead of including the specific numbers in the VBA as shown below. I have a long list of numbers that I need to put in this code: "If((@=76)+(@=77)+(@=82)+(@=85)" for a different workbook, there are a lot of departments and they are longer in length, 8 or 9 digits. It would be easier to paste them in the second tab, intead of typing, as these numbers will also change.

>>> use code - tags <<<

Sub jassybun()
  Dim Nc As Long, Lr As Long
  Dim Ws As Worksheet

  With Sheets("Sheet1")
      Nc = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
      Lr = .Range("A" & Rows.Count).End(xlUp).Row
      With .Range(.Cells(1, Nc), .Cells(Lr, Nc))
        .Value = Evaluate(Replace("If((@=76)+(@=77)+(@=82)+(@=85),true,"""")", "@", .Offset(, -1).Address))
      End With
      .Range("A1", .Cells(Lr, Nc)).AutoFilter Nc, ""
      .AutoFilter.Range.Offset(1).EntireRow.Delete
      .AutoFilterMode = False
      .Columns(Nc).ClearContents
  End With
End Sub

 

[BobBridges]

If I understand your description, you don't need a VBA program for that. Create the table on a second worksheet, as you said, and then use the VLOOKUP function in the first worksheet to look up the one value to find the other. I gotta run for now, but I'll be back this afternoon to see what questions you have.

 

[jassybun]

I do not only need to lookup values but also delete the entire row that has that value. Unfortunately, it is thousands of rows as well.

 

[p45cal]

try:

Sub jassybun2()
Dim Nc As Long, Lr As Long
Dim Ws As Worksheet, rngToDelete As Range
myDepts = Intersect(Sheets("Sheet2").UsedRange, Sheets("Sheet2").Columns(1)).Value
With Sheets("Sheet1")
  Nc = .Cells(1, Columns.Count).End(xlToLeft).Column
  Lr = .Range("A" & Rows.Count).End(xlUp).Row
  Set myRng = Range(.Cells(1, Nc), .Cells(Lr, Nc))
  Set myRng = Intersect(myRng, myRng.Offset(1))
  If Not myRng Is Nothing Then
    For Each cll In myRng.Cells
      If IsError(Application.Match(cll.Value, myDepts, 0)) Then
        If rngToDelete Is Nothing Then Set rngToDelete = cll Else Set rngToDelete = Union(rngToDelete, cll)
      End If
    Next cll
    If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
  End If
End With
End Sub