Help adding deletion of rows before sorting?

C

cspengel

Board Regular
Joined
Oct 29, 2022
Messages
173
Office Version
  1. 365
  2. 2021
Platform
  1. Windows
I am using some code I found that generates combinations, and have made a few adjustments to fit my needs. (other calculations to help filter the data). Everything works as intended however I would like to know how I can delete rows based on cell value. What I am trying to do is delete rows before sorting to optimize how long it takes for the macro to process. If I can delete the the rows where the sum is greater than 60,000, I would save a lot of time. The sorting function takes over 40 minutes sometimes due to the amount of combinations. Then after the macro is done for example, I may only need 200-1000 combinations out of 500,000.

The sort function is highlighted in red and the sum function is highlighted in blue. Thanks for any feedback.

VBA Code: 
Public CalcState As Long
Public EventState As Boolean
Public PageBreakState As Boolean

Sub OptimizeCode_Begin()

Application.ScreenUpdating = False

EventState = Application.EnableEvents
Application.EnableEvents = False

CalcState = Application.Calculation
Application.Calculation = xCalculationManual

PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False

End Sub

Sub OptimizeCode_End()

ActiveSheet.DisplayPageBreaks = PageBreakState
Application.Calculation = CalcState
Application.EnableEvents = EventState
Application.ScreenUpdating = True

End Sub


Sub NameCombos()
    'https://www.mrexcel.com/forum/excel-questions/1106189-all-combinations-multiple-columns-without-duplicates.html
    
    Dim lLastColumn As Long
    Dim lLastUsedColumn As Long
    Dim aryNames As Variant
    Dim lColumnIndex As Long
    Dim lWriteRow As Long
    Dim bCarry As Boolean
    Dim lWriteColumn As Long
    Dim rngWrite As Range
    Dim lFirstWriteColumn As Long
    Dim lLastWriteColumn As Long
    Dim oFound As Object
    Dim lRefColumn As Long
    Dim lInUseRow As Long
    Dim lCarryColumn As Long
    Dim lPrint As Long
    Dim lLastIteration As Long
    Dim lIterationCount As Long
    Dim sErrorMsg As String
    Dim bShowError As Boolean
    Dim lLastRow As Long
    Dim lLastRowDeDuped As Long
    Dim aryDeDupe As Variant

    Dim sName As String
    Dim bDupeName As Boolean
    
    Dim oSD As Object
    Dim rngCell As Range
    Dim varK As Variant, varI As Variant, varTemp As Variant, lIndex As Long
    Dim lRowIndex As Long
    Dim lRowIndex2 As Long
    Dim rngSortRange As Range
    Dim dteStart As Date
    Dim sOutput As String
    Dim lFirstHSortColumn As Long
    Dim lFirstHSortColumn2 As Long
    Dim lFirstHTeamCol As Long
    Dim firstrow As Long
    Dim v
    Dim lLastHTeamCol As Long
    Dim currow As Long
    Dim diff As Long
    Dim lLastHSortColumn As Long
    Dim lLastHSortColumn2 As Long
    Dim lLastSalaryRow As Long
    Dim rngReplace As Range
    Dim wks As Worksheet
    Dim bFoundSalary As Boolean
    Dim sMissingSalary As String
    
    Call OptimizeCode_Begin
    
    Application.StatusBar = False
    
    'Check for salary worksheet
    For Each wks In ThisWorkbook.Worksheets
        If wks.Name = "Salary" Then bFoundSalary = True
    Next
    If Not bFoundSalary Then
        MsgBox "The workbook must contain a worksheet named 'Salary' with data starting in row 2 " & _
            "that consists of column A containing each name in the name/column layout worksheet " & _
            "and column B containng their salary."
        GoTo End_Sub
    End If
    
    'Make sure each name has a corresponding salary entry
    'Initialize the scripting dictionary
    Set oSD = CreateObject("Scripting.Dictionary")
    oSD.CompareMode = vbTextCompare
    'Inventory names on the main worksheet
    For Each rngCell In ActiveSheet.Range("A1").CurrentRegion.Offset(1, 0)
        rngCell.Value = Trim(rngCell.Value)
        If rngCell.Value <> vbNullString Then
            oSD.Item(rngCell.Value) = oSD.Item(rngCell.Value) + 1
        End If
    Next
    'Remove names on the Salary worksheet
    With Worksheets("Salary")
        For Each rngCell In .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
            rngCell.Value = Trim(rngCell.Value)
            If oSD.exists(rngCell.Value) Then
                oSD.Remove rngCell.Value
            End If
        Next
    End With
    
    'Any names not accounted for?
    If oSD.Count <> 0 Then
        varK = oSD.keys
        For lIndex = LBound(varK) To UBound(varK)
            sMissingSalary = sMissingSalary & ", " & varK(lIndex)
        Next
        sMissingSalary = Mid(sMissingSalary, 3)
        sOutput = "The following names on the main worksheet do not have a corresponding entry on the 'Salary' worksheet." & vbLf & vbLf & _
            sMissingSalary
        MsgBox sOutput
        Debug.Print sOutput
        GoTo End_Sub
    End If
    
    sErrorMsg = "Ensure a Worksheet is active with a header row starting in A1" & _
        "and names under each header entry."
    
    If TypeName(ActiveSheet) <> "Worksheet" Then
        bShowError = True
    End If
    
    If bShowError Then
        MsgBox sErrorMsg, , "Problems Found in Data"
        GoTo End_Sub
    End If
    
    lLastColumn = Range("A1").CurrentRegion.Columns.Count
    lLastUsedColumn = ActiveSheet.UsedRange.Columns.Count
    ReDim aryNames(1 To 2, 1 To lLastColumn)    '1 holds the in-use entry row
                                                
    'How many combinations? (Order does not matter)
    lLastIteration = 1
    For lColumnIndex = 1 To lLastColumn
        aryNames(1, lColumnIndex) = 2
        aryNames(2, lColumnIndex) = Cells(Rows.Count, lColumnIndex).End(xlUp).Row
        lLastIteration = lLastIteration * (aryNames(2, lColumnIndex) - 1)
    Next
    
    lRefColumn = lLastColumn + 1
    lFirstWriteColumn = lLastColumn + 2
    lLastWriteColumn = (2 * lLastColumn) + 1
    
    Select Case MsgBox("Process a " & lLastColumn & " column table with " & _
        lLastIteration & " possible combinations?" & vbLf & vbLf & _
        "WARNING: Columns right of the input range will be erased before continuing.", vbOKCancel + vbCritical + _
        vbDefaultButton2, "Process table?")
    Case vbCancel
        GoTo End_Sub
    End Select
    
    dteStart = Now()
    
    'Clear all columns right of input range
    If lLastUsedColumn > lLastColumn Then
        Range(Cells(1, lLastColumn + 1), Cells(1, lLastUsedColumn)).EntireColumn.ClearContents
    End If
    Cells(1, lLastWriteColumn + 1).Value = "ComboID"
    
    'Add Output Header
    Range(Cells(1, 1), Cells(1, lLastColumn)).Copy Destination:=Cells(1, lFirstWriteColumn)
    
    'Start checking combinations
    lWriteRow = 2
    For lIterationCount = 1 To lLastIteration
        If lIterationCount / 1000 = lIterationCount \ 1000 Then Application.StatusBar = _
            lIterationCount & " / " & lLastIteration
            
        'Reset the Dupe Name flag
        bDupeName = False
        
        'Check Active Combo for Dupe Names
        'Initialize the scripting dictionary
        Set oSD = CreateObject("Scripting.Dictionary")
        oSD.CompareMode = vbTextCompare
        
        'Load names into scripting dictionary
        For lColumnIndex = lLastColumn To 1 Step -1
            sName = Cells(aryNames(1, lColumnIndex), lColumnIndex).Value
            oSD.Item(sName) = oSD.Item(sName) + 1
        Next
        
        'If there are names, and at least one duplicate, set the bDupeName flag
        If oSD.Count > 0 Then
            varK = oSD.keys
            varI = oSD.Items
            For lIndex = 1 To oSD.Count
                If varI(lIndex - 1) > 1 Then
                    bDupeName = True: Exit For
                End If
            Next
        End If
        
        
        If Not bDupeName Then
            'The current row had names and no duplicates
            'Print Active Combo to the lWriteRow row
            For lColumnIndex = lLastColumn To 1 Step -1
                lWriteColumn = lColumnIndex + lLastColumn + 2
                Set rngWrite = Range(Cells(lWriteRow, lFirstWriteColumn), Cells(lWriteRow, lLastWriteColumn))
                Cells(lWriteRow, lRefColumn + lColumnIndex).Value = Cells(aryNames(1, lColumnIndex), lColumnIndex).Value
            Next
            
            'Uncomment next row to see the lIterationCount for the printed row
            Cells(lWriteRow, lLastWriteColumn + 1).Value = lIterationCount
            
            'Point to the next blank row
            lWriteRow = lWriteRow + 1
            
        End If
    
        'Increment Counters
        'Whether the line had duplicates or not, move to the next name in the
        '  rightmost column, if it was ag the last name, go to the first name in that column and
        '  move the name in the column to the left down to the next name (recursive check if THAT
        '  column was already using the last name for remaining columns to the left)
        aryNames(1, lLastColumn) = aryNames(1, lLastColumn) + 1
        If aryNames(1, lLastColumn) > aryNames(2, lLastColumn) Then
            bCarry = True
            lCarryColumn = lLastColumn
            Do While bCarry = True And lCarryColumn > 0
                aryNames(1, lCarryColumn) = 2
                bCarry = False
                lCarryColumn = lCarryColumn - 1
                If lCarryColumn = 0 Then Exit Do
                aryNames(1, lCarryColumn) = aryNames(1, lCarryColumn) + 1
                If aryNames(1, lCarryColumn) > aryNames(2, lCarryColumn) Then bCarry = True
            Loop
        End If
        
        'Check counter values (for debug)
'        Debug.Print lWriteRow,
'        For lPrint = 1 To lLastColumn
'            Debug.Print aryNames(1, lPrint) & ", ";
'        Next
'        Debug.Print
        DoEvents
    Next
    
    Application.StatusBar = "Sorting"
    Application.ScreenUpdating = False
    
    'Copy row names to right so that each copied row can be sorted alphabetically left to right
    '  this will allow the Excel remove duplicate fuction to remove rows that have identical names
    '  in all of their sorted columns.
    lLastRow = Cells(Rows.Count, lFirstWriteColumn).End(xlUp).Row
    Range(Cells(1, lFirstWriteColumn), Cells(lLastRow, lLastWriteColumn)).Copy Destination:=Cells(1, lLastWriteColumn + 2) ''SALARY
    lFirstHSortColumn = lLastWriteColumn + 2
    lLastHSortColumn = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Range(Cells(1, lFirstWriteColumn), Cells(lLastRow, lLastWriteColumn)).Copy Destination:=Cells(1, lLastHSortColumn + 1) ''PROJECTION
    lFirstHSortColumn2 = lLastHSortColumn + 1
    lLastHSortColumn2 = Cells(1, Columns.Count).End(xlToLeft).Column
     
    Range(Cells(1, lFirstWriteColumn), Cells(lLastRow, lLastWriteColumn)).Copy Destination:=Cells(1, lLastHSortColumn2 + 1) ''TEAM
    lFirstHTeamCol = lLastHSortColumn2 + 1
    lLastHTeamCol = Cells(1, Columns.Count).End(xlToLeft).Column
     
    [COLOR=rgb(226, 80, 65)]'Sort each row
    Application.ScreenUpdating = False
    lLastRow = Cells(Rows.Count, lFirstWriteColumn).End(xlUp).Row
    For lRowIndex = 2 To lLastRow
        Set rngSortRange = Range(Cells(lRowIndex, lFirstHSortColumn), Cells(lRowIndex, lLastHSortColumn))
        ActiveSheet.Sort.SortFields.Clear
        ActiveSheet.Sort.SortFields.Add Key:=rngSortRange, _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveSheet.Sort
            .SetRange rngSortRange
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlLeftToRight
            .SortMethod = xlPinYin
            .Apply
        End With
    Next[/COLOR]
    
    'Check for duplicate rows in HSort Columns
    '  Can only happen if names are duplicated within an input column
    '  Build aryDeDupe  -- Array(1, 2, 3,...n)  -- to exclude iteration # column

    lLastRow = Cells(Rows.Count, lFirstWriteColumn).End(xlUp).Row
    ReDim aryDeDupe(0 To lLastHSortColumn - lFirstHSortColumn)
    lIndex = 0
    For lColumnIndex = lFirstHSortColumn To lLastHSortColumn
        aryDeDupe(lIndex) = CInt(lColumnIndex - lFirstWriteColumn + 1)
        lIndex = lIndex + 1
    Next
    ActiveSheet.Cells(1, lFirstWriteColumn).CurrentRegion.RemoveDuplicates Columns:=(aryDeDupe), Header:=xlYes
    'Above line won't work unless there are parens around the Columns argument ?????
    
    lLastRowDeDuped = Cells(Rows.Count, lFirstWriteColumn).End(xlUp).Row
    
    'Assumes the 'Salary' worksheet has names in the column A and salaries in column B starting in row 2
    'Replace HSort names with salary
    With Worksheets("Salary") '''' SALARY
        lLastSalaryRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    Set rngReplace = Range(Cells(2, lFirstHSortColumn), Cells(lLastRow, lLastHSortColumn))
    For lRowIndex = 2 To lLastSalaryRow
        rngReplace.Replace What:=Worksheets("Salary").Cells(lRowIndex, 1).Value, _
            Replacement:=Worksheets("Salary").Cells(lRowIndex, 2).Value, LookAt:=xlWhole, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
     Next
     '''''''''''''''''''''''''''''''''''''PROJECTION
     With Worksheets("Salary")
        lLastSalaryRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    Set rngReplace = Range(Cells(2, lFirstHSortColumn2), Cells(lLastRow, lLastHSortColumn2))
    For lRowIndex2 = 2 To lLastSalaryRow
        rngReplace.Replace What:=Worksheets("Salary").Cells(lRowIndex2, 1).Value, _
            Replacement:=Worksheets("Salary").Cells(lRowIndex2, 3).Value, LookAt:=xlWhole, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    Next '''''''''''''''''''''''''''
    
         '''''''''''''''''''''''''''''''''''''TEAM
     With Worksheets("Salary")
        lLastSalaryRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    Set rngReplace = Range(Cells(2, lFirstHTeamCol), Cells(lLastRow, lLastHTeamCol))
    For lRowIndex2 = 2 To lLastSalaryRow
        rngReplace.Replace What:=Worksheets("Salary").Cells(lRowIndex2, 1).Value, _
            Replacement:=Worksheets("Salary").Cells(lRowIndex2, 4).Value, LookAt:=xlWhole, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    Next '''''''''''''''''''''''''''
    
    [COLOR=rgb(44, 130, 201)]'Add Sum Column
   Cells(1, lLastHTeamCol + 1).Value = ChrW(931) & " Salary"
    With Range(Cells(2, lLastHTeamCol + 1), Cells(lLastRowDeDuped, lLastHTeamCol + 1))
        .FormulaR1C1 = "=SUM(RC" & lFirstHSortColumn & ":RC" & lLastHSortColumn & ")"
        Application.Calculate
        .Value = .Value
    End With[/COLOR]
    
    ''Add Projection Column
    Cells(1, lLastHTeamCol + 2).Value = ChrW(931) & " Projection"
    With Range(Cells(2, lLastHTeamCol + 2), Cells(lLastRowDeDuped, lLastHTeamCol + 2))
        .FormulaR1C1 = "=SUM(RC" & lFirstHSortColumn2 & ":RC" & lLastHSortColumn2 & ")"
        Application.Calculate
        .Value = .Value
    End With
    
     ''Add Team Stack Column
    Cells(1, lLastHTeamCol + 3).Value = ChrW(931) & " Stack"
    With Range(Cells(2, lLastHTeamCol + 3), Cells(lLastRowDeDuped, lLastHTeamCol + 3))
        .FormulaR1C1 = "=INDEX(RC" & lFirstHTeamCol & ":RC" & lLastHTeamCol & ",MODE(MATCH(RC" & lFirstHTeamCol & ":RC" & lLastHTeamCol & ",RC" & lFirstHTeamCol & ":RC" & lLastHTeamCol & ",0)))"
        Application.Calculate
        .Value = .Value
    End With
    
    ''Add Team Stack Pos
    Cells(1, lLastHTeamCol + 4).Value = ChrW(931) & " Stack POS"
    With Range(Cells(2, lLastHTeamCol + 4), Cells(lLastRowDeDuped, lLastHTeamCol + 4))
    
    .Formula2R1C1 = "=TEXTJOIN("","",1,IF(RC[-12]:RC[-4]=RC[-1],R1C[-12]:R1C[-4],""""))"
        Application.Calculate
        .Value = .Value
    End With
    
    ''Add 2nd Team Stack Column
    Cells(1, lLastHTeamCol + 5).Value = ChrW(931) & " Stack2"
    With Range(Cells(2, lLastHTeamCol + 5), Cells(lLastRowDeDuped, lLastHTeamCol + 5))
        .Formula2R1C1 = "=IFERROR(INDEX(RC[-13]:RC[-5],MODE(IF((RC[-13]:RC[-5]<>"""")*(RC[-13]:RC[-5]<>INDEX(RC[-13]:RC[-5],MODE(IF(RC[-13]:RC[-5]<>"""",MATCH(RC[-13]:RC[-5],RC[-13]:RC[-5],0))))),MATCH(RC[-13]:RC[-5],RC[-13]:RC[-5],0)))),"""")"
        Application.Calculate
        .Value = .Value
    End With
    
    ''Add 2nd Team Stack Pos
    Cells(1, lLastHTeamCol + 6).Value = ChrW(931) & " Stack2 POS"
    With Range(Cells(2, lLastHTeamCol + 6), Cells(lLastRowDeDuped, lLastHTeamCol + 6))
    
    .Formula2R1C1 = "=TEXTJOIN("","",1,IF(RC[-12]:RC[-4]=RC[-1],R1C[-12]:R1C[-4],""""))"
        Application.Calculate
        .Value = .Value
    End With
    
    'Filter 0-1
    Cells(1, lLastHTeamCol + 7).Value = ChrW(931) & " Filter"
    With Range(Cells(2, lLastHTeamCol + 7), Cells(lLastRowDeDuped, lLastHTeamCol + 7))
    
    End With
    
    'Player 1 Filter
    Cells(1, lLastHTeamCol + 8).Value = ChrW(931) & " Player1"
    With Range(Cells(2, lLastHTeamCol + 8), Cells(lLastRowDeDuped, lLastHTeamCol + 8))
    
    End With
    
    'Player 2 Filter
    Cells(1, lLastHTeamCol + 9).Value = ChrW(931) & " Player2"
    With Range(Cells(2, lLastHTeamCol + 9), Cells(lLastRowDeDuped, lLastHTeamCol + 9))
    
    End With
   
    
    'Remove Salary Columns
    Range(Cells(2, lFirstHSortColumn), Cells(lLastRowDeDuped, lLastHTeamCol)).EntireColumn.Delete

    
    
    sOutput = lLastIteration & vbTab & " possible combinations" & vbLf & _
        lLastRow - 1 & vbTab & " unique name combinations" & vbLf & _
        IIf(lLastRowDeDuped <> lLastRow, lLastRow - lLastRowDeDuped & vbTab & " duplicate rows removed." & vbLf, "") & _
        lLastRowDeDuped - 1 & vbTab & " printed." & vbLf & vbLf & _
        Format(Now() - dteStart, "hh:mm:ss") & " to process."
    
    ActiveSheet.UsedRange.Columns.AutoFit
    MsgBox sOutput, , "Output Report"
    Debug.Print sOutput
        
End_Sub:
    Call OptimizeCode_End
    Application.StatusBar = False
    
End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Sort by date Sort by votes
cspengel said:
I am using some code I found that generates combinations, and have made a few adjustments to fit my needs. (other calculations to help filter the data). Everything works as intended however I would like to know how I can delete rows based on cell value. What I am trying to do is delete rows before sorting to optimize how long it takes for the macro to process. If I can delete the the rows where the sum is greater than 60,000, I would save a lot of time. The sorting function takes over 40 minutes sometimes due to the amount of combinations. Then after the macro is done for example, I may only need 200-1000 combinations out of 500,000.

The sort function is highlighted in red and the sum function is highlighted in blue. Thanks for any feedback.

VBA Code: 
Public CalcState As Long
Public EventState As Boolean
Public PageBreakState As Boolean

Sub OptimizeCode_Begin()

Application.ScreenUpdating = False

EventState = Application.EnableEvents
Application.EnableEvents = False

CalcState = Application.Calculation
Application.Calculation = xCalculationManual

PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False

End Sub

Sub OptimizeCode_End()

ActiveSheet.DisplayPageBreaks = PageBreakState
Application.Calculation = CalcState
Application.EnableEvents = EventState
Application.ScreenUpdating = True

End Sub


Sub NameCombos()
    'https://www.mrexcel.com/forum/excel-questions/1106189-all-combinations-multiple-columns-without-duplicates.html
   
    Dim lLastColumn As Long
    Dim lLastUsedColumn As Long
    Dim aryNames As Variant
    Dim lColumnIndex As Long
    Dim lWriteRow As Long
    Dim bCarry As Boolean
    Dim lWriteColumn As Long
    Dim rngWrite As Range
    Dim lFirstWriteColumn As Long
    Dim lLastWriteColumn As Long
    Dim oFound As Object
    Dim lRefColumn As Long
    Dim lInUseRow As Long
    Dim lCarryColumn As Long
    Dim lPrint As Long
    Dim lLastIteration As Long
    Dim lIterationCount As Long
    Dim sErrorMsg As String
    Dim bShowError As Boolean
    Dim lLastRow As Long
    Dim lLastRowDeDuped As Long
    Dim aryDeDupe As Variant

    Dim sName As String
    Dim bDupeName As Boolean
   
    Dim oSD As Object
    Dim rngCell As Range
    Dim varK As Variant, varI As Variant, varTemp As Variant, lIndex As Long
    Dim lRowIndex As Long
    Dim lRowIndex2 As Long
    Dim rngSortRange As Range
    Dim dteStart As Date
    Dim sOutput As String
    Dim lFirstHSortColumn As Long
    Dim lFirstHSortColumn2 As Long
    Dim lFirstHTeamCol As Long
    Dim firstrow As Long
    Dim v
    Dim lLastHTeamCol As Long
    Dim currow As Long
    Dim diff As Long
    Dim lLastHSortColumn As Long
    Dim lLastHSortColumn2 As Long
    Dim lLastSalaryRow As Long
    Dim rngReplace As Range
    Dim wks As Worksheet
    Dim bFoundSalary As Boolean
    Dim sMissingSalary As String
   
    Call OptimizeCode_Begin
   
    Application.StatusBar = False
   
    'Check for salary worksheet
    For Each wks In ThisWorkbook.Worksheets
        If wks.Name = "Salary" Then bFoundSalary = True
    Next
    If Not bFoundSalary Then
        MsgBox "The workbook must contain a worksheet named 'Salary' with data starting in row 2 " & _
            "that consists of column A containing each name in the name/column layout worksheet " & _
            "and column B containng their salary."
        GoTo End_Sub
    End If
   
    'Make sure each name has a corresponding salary entry
    'Initialize the scripting dictionary
    Set oSD = CreateObject("Scripting.Dictionary")
    oSD.CompareMode = vbTextCompare
    'Inventory names on the main worksheet
    For Each rngCell In ActiveSheet.Range("A1").CurrentRegion.Offset(1, 0)
        rngCell.Value = Trim(rngCell.Value)
        If rngCell.Value <> vbNullString Then
            oSD.Item(rngCell.Value) = oSD.Item(rngCell.Value) + 1
        End If
    Next
    'Remove names on the Salary worksheet
    With Worksheets("Salary")
        For Each rngCell In .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
            rngCell.Value = Trim(rngCell.Value)
            If oSD.exists(rngCell.Value) Then
                oSD.Remove rngCell.Value
            End If
        Next
    End With
   
    'Any names not accounted for?
    If oSD.Count <> 0 Then
        varK = oSD.keys
        For lIndex = LBound(varK) To UBound(varK)
            sMissingSalary = sMissingSalary & ", " & varK(lIndex)
        Next
        sMissingSalary = Mid(sMissingSalary, 3)
        sOutput = "The following names on the main worksheet do not have a corresponding entry on the 'Salary' worksheet." & vbLf & vbLf & _
            sMissingSalary
        MsgBox sOutput
        Debug.Print sOutput
        GoTo End_Sub
    End If
   
    sErrorMsg = "Ensure a Worksheet is active with a header row starting in A1" & _
        "and names under each header entry."
   
    If TypeName(ActiveSheet) <> "Worksheet" Then
        bShowError = True
    End If
   
    If bShowError Then
        MsgBox sErrorMsg, , "Problems Found in Data"
        GoTo End_Sub
    End If
   
    lLastColumn = Range("A1").CurrentRegion.Columns.Count
    lLastUsedColumn = ActiveSheet.UsedRange.Columns.Count
    ReDim aryNames(1 To 2, 1 To lLastColumn)    '1 holds the in-use entry row
                                               
    'How many combinations? (Order does not matter)
    lLastIteration = 1
    For lColumnIndex = 1 To lLastColumn
        aryNames(1, lColumnIndex) = 2
        aryNames(2, lColumnIndex) = Cells(Rows.Count, lColumnIndex).End(xlUp).Row
        lLastIteration = lLastIteration * (aryNames(2, lColumnIndex) - 1)
    Next
   
    lRefColumn = lLastColumn + 1
    lFirstWriteColumn = lLastColumn + 2
    lLastWriteColumn = (2 * lLastColumn) + 1
   
    Select Case MsgBox("Process a " & lLastColumn & " column table with " & _
        lLastIteration & " possible combinations?" & vbLf & vbLf & _
        "WARNING: Columns right of the input range will be erased before continuing.", vbOKCancel + vbCritical + _
        vbDefaultButton2, "Process table?")
    Case vbCancel
        GoTo End_Sub
    End Select
   
    dteStart = Now()
   
    'Clear all columns right of input range
    If lLastUsedColumn > lLastColumn Then
        Range(Cells(1, lLastColumn + 1), Cells(1, lLastUsedColumn)).EntireColumn.ClearContents
    End If
    Cells(1, lLastWriteColumn + 1).Value = "ComboID"
   
    'Add Output Header
    Range(Cells(1, 1), Cells(1, lLastColumn)).Copy Destination:=Cells(1, lFirstWriteColumn)
   
    'Start checking combinations
    lWriteRow = 2
    For lIterationCount = 1 To lLastIteration
        If lIterationCount / 1000 = lIterationCount \ 1000 Then Application.StatusBar = _
            lIterationCount & " / " & lLastIteration
           
        'Reset the Dupe Name flag
        bDupeName = False
       
        'Check Active Combo for Dupe Names
        'Initialize the scripting dictionary
        Set oSD = CreateObject("Scripting.Dictionary")
        oSD.CompareMode = vbTextCompare
       
        'Load names into scripting dictionary
        For lColumnIndex = lLastColumn To 1 Step -1
            sName = Cells(aryNames(1, lColumnIndex), lColumnIndex).Value
            oSD.Item(sName) = oSD.Item(sName) + 1
        Next
       
        'If there are names, and at least one duplicate, set the bDupeName flag
        If oSD.Count > 0 Then
            varK = oSD.keys
            varI = oSD.Items
            For lIndex = 1 To oSD.Count
                If varI(lIndex - 1) > 1 Then
                    bDupeName = True: Exit For
                End If
            Next
        End If
       
       
        If Not bDupeName Then
            'The current row had names and no duplicates
            'Print Active Combo to the lWriteRow row
            For lColumnIndex = lLastColumn To 1 Step -1
                lWriteColumn = lColumnIndex + lLastColumn + 2
                Set rngWrite = Range(Cells(lWriteRow, lFirstWriteColumn), Cells(lWriteRow, lLastWriteColumn))
                Cells(lWriteRow, lRefColumn + lColumnIndex).Value = Cells(aryNames(1, lColumnIndex), lColumnIndex).Value
            Next
           
            'Uncomment next row to see the lIterationCount for the printed row
            Cells(lWriteRow, lLastWriteColumn + 1).Value = lIterationCount
           
            'Point to the next blank row
            lWriteRow = lWriteRow + 1
           
        End If
   
        'Increment Counters
        'Whether the line had duplicates or not, move to the next name in the
        '  rightmost column, if it was ag the last name, go to the first name in that column and
        '  move the name in the column to the left down to the next name (recursive check if THAT
        '  column was already using the last name for remaining columns to the left)
        aryNames(1, lLastColumn) = aryNames(1, lLastColumn) + 1
        If aryNames(1, lLastColumn) > aryNames(2, lLastColumn) Then
            bCarry = True
            lCarryColumn = lLastColumn
            Do While bCarry = True And lCarryColumn > 0
                aryNames(1, lCarryColumn) = 2
                bCarry = False
                lCarryColumn = lCarryColumn - 1
                If lCarryColumn = 0 Then Exit Do
                aryNames(1, lCarryColumn) = aryNames(1, lCarryColumn) + 1
                If aryNames(1, lCarryColumn) > aryNames(2, lCarryColumn) Then bCarry = True
            Loop
        End If
       
        'Check counter values (for debug)
'        Debug.Print lWriteRow,
'        For lPrint = 1 To lLastColumn
'            Debug.Print aryNames(1, lPrint) & ", ";
'        Next
'        Debug.Print
        DoEvents
    Next
   
    Application.StatusBar = "Sorting"
    Application.ScreenUpdating = False
   
    'Copy row names to right so that each copied row can be sorted alphabetically left to right
    '  this will allow the Excel remove duplicate fuction to remove rows that have identical names
    '  in all of their sorted columns.
    lLastRow = Cells(Rows.Count, lFirstWriteColumn).End(xlUp).Row
    Range(Cells(1, lFirstWriteColumn), Cells(lLastRow, lLastWriteColumn)).Copy Destination:=Cells(1, lLastWriteColumn + 2) ''SALARY
    lFirstHSortColumn = lLastWriteColumn + 2
    lLastHSortColumn = Cells(1, Columns.Count).End(xlToLeft).Column
   
    Range(Cells(1, lFirstWriteColumn), Cells(lLastRow, lLastWriteColumn)).Copy Destination:=Cells(1, lLastHSortColumn + 1) ''PROJECTION
    lFirstHSortColumn2 = lLastHSortColumn + 1
    lLastHSortColumn2 = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Range(Cells(1, lFirstWriteColumn), Cells(lLastRow, lLastWriteColumn)).Copy Destination:=Cells(1, lLastHSortColumn2 + 1) ''TEAM
    lFirstHTeamCol = lLastHSortColumn2 + 1
    lLastHTeamCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    [COLOR=rgb(226, 80, 65)]'Sort each row
    Application.ScreenUpdating = False
    lLastRow = Cells(Rows.Count, lFirstWriteColumn).End(xlUp).Row
    For lRowIndex = 2 To lLastRow
        Set rngSortRange = Range(Cells(lRowIndex, lFirstHSortColumn), Cells(lRowIndex, lLastHSortColumn))
        ActiveSheet.Sort.SortFields.Clear
        ActiveSheet.Sort.SortFields.Add Key:=rngSortRange, _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveSheet.Sort
            .SetRange rngSortRange
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlLeftToRight
            .SortMethod = xlPinYin
            .Apply
        End With
    Next[/COLOR]
   
    'Check for duplicate rows in HSort Columns
    '  Can only happen if names are duplicated within an input column
    '  Build aryDeDupe  -- Array(1, 2, 3,...n)  -- to exclude iteration # column

    lLastRow = Cells(Rows.Count, lFirstWriteColumn).End(xlUp).Row
    ReDim aryDeDupe(0 To lLastHSortColumn - lFirstHSortColumn)
    lIndex = 0
    For lColumnIndex = lFirstHSortColumn To lLastHSortColumn
        aryDeDupe(lIndex) = CInt(lColumnIndex - lFirstWriteColumn + 1)
        lIndex = lIndex + 1
    Next
    ActiveSheet.Cells(1, lFirstWriteColumn).CurrentRegion.RemoveDuplicates Columns:=(aryDeDupe), Header:=xlYes
    'Above line won't work unless there are parens around the Columns argument ?????
   
    lLastRowDeDuped = Cells(Rows.Count, lFirstWriteColumn).End(xlUp).Row
   
    'Assumes the 'Salary' worksheet has names in the column A and salaries in column B starting in row 2
    'Replace HSort names with salary
    With Worksheets("Salary") '''' SALARY
        lLastSalaryRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    Set rngReplace = Range(Cells(2, lFirstHSortColumn), Cells(lLastRow, lLastHSortColumn))
    For lRowIndex = 2 To lLastSalaryRow
        rngReplace.Replace What:=Worksheets("Salary").Cells(lRowIndex, 1).Value, _
            Replacement:=Worksheets("Salary").Cells(lRowIndex, 2).Value, LookAt:=xlWhole, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
     Next
     '''''''''''''''''''''''''''''''''''''PROJECTION
     With Worksheets("Salary")
        lLastSalaryRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    Set rngReplace = Range(Cells(2, lFirstHSortColumn2), Cells(lLastRow, lLastHSortColumn2))
    For lRowIndex2 = 2 To lLastSalaryRow
        rngReplace.Replace What:=Worksheets("Salary").Cells(lRowIndex2, 1).Value, _
            Replacement:=Worksheets("Salary").Cells(lRowIndex2, 3).Value, LookAt:=xlWhole, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    Next '''''''''''''''''''''''''''
   
         '''''''''''''''''''''''''''''''''''''TEAM
     With Worksheets("Salary")
        lLastSalaryRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    Set rngReplace = Range(Cells(2, lFirstHTeamCol), Cells(lLastRow, lLastHTeamCol))
    For lRowIndex2 = 2 To lLastSalaryRow
        rngReplace.Replace What:=Worksheets("Salary").Cells(lRowIndex2, 1).Value, _
            Replacement:=Worksheets("Salary").Cells(lRowIndex2, 4).Value, LookAt:=xlWhole, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    Next '''''''''''''''''''''''''''
   
    [COLOR=rgb(44, 130, 201)]'Add Sum Column
   Cells(1, lLastHTeamCol + 1).Value = ChrW(931) & " Salary"
    With Range(Cells(2, lLastHTeamCol + 1), Cells(lLastRowDeDuped, lLastHTeamCol + 1))
        .FormulaR1C1 = "=SUM(RC" & lFirstHSortColumn & ":RC" & lLastHSortColumn & ")"
        Application.Calculate
        .Value = .Value
    End With[/COLOR]
   
    ''Add Projection Column
    Cells(1, lLastHTeamCol + 2).Value = ChrW(931) & " Projection"
    With Range(Cells(2, lLastHTeamCol + 2), Cells(lLastRowDeDuped, lLastHTeamCol + 2))
        .FormulaR1C1 = "=SUM(RC" & lFirstHSortColumn2 & ":RC" & lLastHSortColumn2 & ")"
        Application.Calculate
        .Value = .Value
    End With
   
     ''Add Team Stack Column
    Cells(1, lLastHTeamCol + 3).Value = ChrW(931) & " Stack"
    With Range(Cells(2, lLastHTeamCol + 3), Cells(lLastRowDeDuped, lLastHTeamCol + 3))
        .FormulaR1C1 = "=INDEX(RC" & lFirstHTeamCol & ":RC" & lLastHTeamCol & ",MODE(MATCH(RC" & lFirstHTeamCol & ":RC" & lLastHTeamCol & ",RC" & lFirstHTeamCol & ":RC" & lLastHTeamCol & ",0)))"
        Application.Calculate
        .Value = .Value
    End With
   
    ''Add Team Stack Pos
    Cells(1, lLastHTeamCol + 4).Value = ChrW(931) & " Stack POS"
    With Range(Cells(2, lLastHTeamCol + 4), Cells(lLastRowDeDuped, lLastHTeamCol + 4))
   
    .Formula2R1C1 = "=TEXTJOIN("","",1,IF(RC[-12]:RC[-4]=RC[-1],R1C[-12]:R1C[-4],""""))"
        Application.Calculate
        .Value = .Value
    End With
   
    ''Add 2nd Team Stack Column
    Cells(1, lLastHTeamCol + 5).Value = ChrW(931) & " Stack2"
    With Range(Cells(2, lLastHTeamCol + 5), Cells(lLastRowDeDuped, lLastHTeamCol + 5))
        .Formula2R1C1 = "=IFERROR(INDEX(RC[-13]:RC[-5],MODE(IF((RC[-13]:RC[-5]<>"""")*(RC[-13]:RC[-5]<>INDEX(RC[-13]:RC[-5],MODE(IF(RC[-13]:RC[-5]<>"""",MATCH(RC[-13]:RC[-5],RC[-13]:RC[-5],0))))),MATCH(RC[-13]:RC[-5],RC[-13]:RC[-5],0)))),"""")"
        Application.Calculate
        .Value = .Value
    End With
   
    ''Add 2nd Team Stack Pos
    Cells(1, lLastHTeamCol + 6).Value = ChrW(931) & " Stack2 POS"
    With Range(Cells(2, lLastHTeamCol + 6), Cells(lLastRowDeDuped, lLastHTeamCol + 6))
   
    .Formula2R1C1 = "=TEXTJOIN("","",1,IF(RC[-12]:RC[-4]=RC[-1],R1C[-12]:R1C[-4],""""))"
        Application.Calculate
        .Value = .Value
    End With
   
    'Filter 0-1
    Cells(1, lLastHTeamCol + 7).Value = ChrW(931) & " Filter"
    With Range(Cells(2, lLastHTeamCol + 7), Cells(lLastRowDeDuped, lLastHTeamCol + 7))
   
    End With
   
    'Player 1 Filter
    Cells(1, lLastHTeamCol + 8).Value = ChrW(931) & " Player1"
    With Range(Cells(2, lLastHTeamCol + 8), Cells(lLastRowDeDuped, lLastHTeamCol + 8))
   
    End With
   
    'Player 2 Filter
    Cells(1, lLastHTeamCol + 9).Value = ChrW(931) & " Player2"
    With Range(Cells(2, lLastHTeamCol + 9), Cells(lLastRowDeDuped, lLastHTeamCol + 9))
   
    End With
  
   
    'Remove Salary Columns
    Range(Cells(2, lFirstHSortColumn), Cells(lLastRowDeDuped, lLastHTeamCol)).EntireColumn.Delete

   
   
    sOutput = lLastIteration & vbTab & " possible combinations" & vbLf & _
        lLastRow - 1 & vbTab & " unique name combinations" & vbLf & _
        IIf(lLastRowDeDuped <> lLastRow, lLastRow - lLastRowDeDuped & vbTab & " duplicate rows removed." & vbLf, "") & _
        lLastRowDeDuped - 1 & vbTab & " printed." & vbLf & vbLf & _
        Format(Now() - dteStart, "hh:mm:ss") & " to process."
   
    ActiveSheet.UsedRange.Columns.AutoFit
    MsgBox sOutput, , "Output Report"
    Debug.Print sOutput
       
End_Sub:
    Call OptimizeCode_End
    Application.StatusBar = False
   
End Sub
Click to expand...
Basically I need this:
VBA Code: 
'Assumes the 'Salary' worksheet has names in the column A and salaries in column B starting in row 2
    'Replace HSort names with salary
    With Worksheets("Salary") '''' SALARY
        lLastSalaryRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    Set rngReplace = Range(Cells(2, lFirstHSortColumn), Cells(lLastRow, lLastHSortColumn))
    For lRowIndex = 2 To lLastSalaryRow
        rngReplace.Replace What:=Worksheets("Salary").Cells(lRowIndex, 1).Value, _
            Replacement:=Worksheets("Salary").Cells(lRowIndex, 2).Value, LookAt:=xlWhole, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
     Next

  Cells(1, lLastHTeamCol + 1).Value = ChrW(931) & " Salary"
    With Range(Cells(2, lLastHTeamCol + 1), Cells(lLastRowDeDuped, lLastHTeamCol + 1))
        .FormulaR1C1 = "=SUM(RC" & lFirstHSortColumn & ":RC" & lLastHSortColumn & ")"
        Application.Calculate
        .Value = .Value

to occur before this:
VBA Code: 
'Sort each row
    Application.ScreenUpdating = False
    lLastRow = Cells(Rows.Count, lFirstWriteColumn).End(xlUp).Row
    For lRowIndex = 2 To lLastRow
        Set rngSortRange = Range(Cells(lRowIndex, lFirstHSortColumn), Cells(lRowIndex, lLastHSortColumn))
        ActiveSheet.Sort.SortFields.Clear
        ActiveSheet.Sort.SortFields.Add Key:=rngSortRange, _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveSheet.Sort
            .SetRange rngSortRange
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlLeftToRight
            .SortMethod = xlPinYin
            .Apply
        End With

and have it delete cells in in column " lLastHTeamCol + 1" if value is over 60,000
 
Upvote 0
Okay this code works for deleting to what I need however it removed data I have in columns A:I that I need. Is there anyway to apply the filter delete to only delete the range as in the code??

VBA Code: 
 lngLastRow = Cells(Rows.Count, lLastHTeamCol + 1).End(xlUp).Row
        
         x = 60000
        With ActiveSheet
            With Intersect(.Columns("AV:AV"), .UsedRange)
            .AutoFilter Field:=1, Criteria1:=">" & x
            .Range(Cells(2, lFirstWriteColumn), Cells(lngLastRow, lLastHTeamCol + 9)).Delete Shift:=xlUp
            .AutoFilter
            End With
            End With
 
Upvote 0
What do you have 'lFirstWriteColumn)' & 'lLastHTeamCol' set to?
 
Upvote 0
johnnyL said:
What do you have 'lFirstWriteColumn)' & 'lLastHTeamCol' set to?
Click to expand...

lLastColumn = Range("A1").CurrentRegion.Columns.Count

lFirstWriteColumn = lLastColumn + 2
lLastHTeamCol = Cells(1, Columns.Count).End(xlToLeft).Column

Basically I have a list of names which can range from 5 to 9 columns(COLUMNS A:I). The combinations began generating 2 columns after whatever is the last column with names. So if I have names in columns A B C D E F G H I, my combinations will be generating in K:S, with helper columns extending from T:AU. None of that is really important except for the fact that I need what is entered in A:I to not be apart of my filtered range.
 
Upvote 0
cspengel said:
lngLastRow = Cells(Rows.Count, lLastHTeamCol + 1).End(xlUp).Row

x = 60000
With ActiveSheet
With Intersect(.Columns("AV:AV"), .UsedRange)
.AutoFilter Field:=1, Criteria1:=">" & x
.Range(Cells(2, lFirstWriteColumn), Cells(lngLastRow, lLastHTeamCol + 9)).Delete Shift:=xlUp
.AutoFilter
End With
End With
Click to expand...

It's difficult to predict without seeing a before & after example but try the following code:

VBA Code: 
    Dim lFirstWriteColumn   As Long
    Dim lLastColumn         As Long
    Dim lngLastRow          As Long
    Dim x                   As Long
    Dim lLastHTeamCol       As Long
    Dim RangesToDelete      As Range
'
'
    lLastColumn = Range("A1").CurrentRegion.Columns.Count
'
    lFirstWriteColumn = lLastColumn + 2
'
    lLastHTeamCol = Cells(1, Columns.Count).End(xlToLeft).Column
'
    lngLastRow = Cells(Rows.Count, lLastHTeamCol + 1).End(xlUp).Row
'
    x = 60000
'
    With ActiveSheet
        With .Columns("AV:AV")
            .AutoFilter Field:=1, Criteria1:=">" & x
'
            On Error Resume Next
                Set RangesToDelete = Range(Cells(2, lFirstWriteColumn), Cells(lngLastRow, lLastHTeamCol + 9)).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
'
            .AutoFilter
'
            If Not RangesToDelete Is Nothing Then
                RangesToDelete.Delete Shift:=xlShiftUp
            End If
'
        End With
    End With
 
Upvote 0
johnnyL said:
It's difficult to predict without seeing a before & after example but try the following code:

VBA Code: 
    Dim lFirstWriteColumn   As Long
    Dim lLastColumn         As Long
    Dim lngLastRow          As Long
    Dim x                   As Long
    Dim lLastHTeamCol       As Long
    Dim RangesToDelete      As Range
'
'
    lLastColumn = Range("A1").CurrentRegion.Columns.Count
'
    lFirstWriteColumn = lLastColumn + 2
'
    lLastHTeamCol = Cells(1, Columns.Count).End(xlToLeft).Column
'
    lngLastRow = Cells(Rows.Count, lLastHTeamCol + 1).End(xlUp).Row
'
    x = 60000
'
    With ActiveSheet
        With .Columns("AV:AV")
            .AutoFilter Field:=1, Criteria1:=">" & x
'
            On Error Resume Next
                Set RangesToDelete = Range(Cells(2, lFirstWriteColumn), Cells(lngLastRow, lLastHTeamCol + 9)).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
'
            .AutoFilter
'
            If Not RangesToDelete Is Nothing Then
                RangesToDelete.Delete Shift:=xlShiftUp
            End If
'
        End With
    End With
Click to expand...
Appreciate your time! I ran your code and for some reason, it isn't finding any combinations. Or atleast it isn't showing any. I have attached 3 images.

1st image is before the macro is ran in which I have names listed in columns A:I.
2nd Image is after I ran your code. Notice how nothing is generated to the right, or at least nothing is showing.
3rd image is after I ran the code I attached. Notice how it has combinations of salary 60000 or less, but my data in A:I is now gone.
 

Attachments

  • before.png
    before.png
    47.9 KB · Views: 9
  • after.png
    after.png
    57.2 KB · Views: 7
  • after2.png
    after2.png
    150.7 KB · Views: 8
Upvote 0
My last post only addressed post #3 in this thread.

That is why I quoted it. ;)
 
Upvote 0
johnnyL said:
My last post only addressed post #3 in this thread.

That is why I quoted it. ;)
Click to expand...
Haha, I know. I'm saying I replaced the code I posted in my post #3 with yours and the pictures above are the results. For some reason it loses the combinations with yours. I added your code to the whole thing.
 
Upvote 0
You still haven't provided relevant data to post #3.

I don't see any data regarding 60000 for column AV for example.

You need to supply sample data for the before & the data that you expect after the code in post #3 has ran.

Have a look here
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
VBA with 400000+ Combinations. Can it run faster?
Replies
1
Views
635
StephenCrump
S
C
  • Solved
Help with max rows of a million+
14 15 16
Replies
151
Views
8K
johnnyL
J
A
  • Question Question
All Combinations No Duplicates Macro
Replies
1
Views
855
andrew_milonavic
A
C
  • Question Question
Random selection of filtered rows.
Replies
2
Views
1K
cspengel
C
C
  • Solved
Why is this code not deleting?
2
Replies
15
Views
971
kevin9999
K

Forum statistics

Threads
1,223,879
Messages
6,175,148
Members
452,615
Latest member
bogeys2birdies

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