Excel VBA ClearContents Dynamically - Stack Overflow

admin管理员组

文章数量:1122796

my Excel spreadsheet is a list of cases. There are 500 rows, and the case information ranges from columns C through R.

I created option buttons for each row, which allows me to "select" a case by clicking that option button. My VLOOKUP formula identifies the correct case in another sheet based on my selection.

Now I am trying to create a button that allows me to move a selected case from my spreadsheet onto another sheet. I know how to do this, but my method is extremely cumbersome because it requires me to enter the cell references for each row. There are 500 of them, so it would take a long time. Is there a way to programmatically expedite this?

Here is my way of achieving my desired result, but it takes too long. As you can see, I stopped after "ElseIf selection = 3" as I realized I would have to do this 500 times. I would rather not have to input 500 "ElseIf selection = " entries and change the cell references in the "Erase from Case List" section below. Any solutions?

Sub Archive_Case()

Dim selection As Integer

selection = Range("Calculations!A2").Value

Dim Workbook As Workbook 'This Workbook
Dim Cases As Worksheet 'Cases Worksheet
Dim Calculations As Worksheet 'Calculations
Dim Dispo As Worksheet 'Dispo

Set Workbook = ThisWorkbook
Set Cases = Workbook.Sheets("Cases")
Set Calculations = Workbook.Sheets("Calculations")
Set Dispo = Workbook.Sheets("Dispo")

If selection = 0 Then

    MsgBox "Select a case that you want to archive."

ElseIf selection = 1 Then

    If MsgBox("Do you really want to archive this case and remove it from this list?", vbYesNo) = vbNo Then Exit Sub

'Copy into Dispo List
    Application.ScreenUpdating = False
        'Dispo.Unprotect
        Worksheets("Calculations").Range("M16:AB16").Copy
        Dispo.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        'Dispo.Protect
    Application.ScreenUpdating = True

'Erase from Case List
    With Cases

    .Select
    .Range("C11:R11").ClearContents
    .Range("C11").Select

    End With

ElseIf selection = 2 Then

    If MsgBox("Do you really want to archive this case and remove it from this list?", vbYesNo) = vbNo Then Exit Sub

'Copy into Dispo List
    Application.ScreenUpdating = False
        'Dispo.Unprotect
        Worksheets("Calculations").Range("M16:AB16").Copy
        Dispo.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        'Dispo.Protect
    Application.ScreenUpdating = True

'Erase from Case List
    With Cases

    .Select
    .Range("C12:R12").ClearContents
    .Range("C12").Select

    End With

ElseIf selection = 3 Then

    If MsgBox("Do you really want to archive this case and remove it from this list?", vbYesNo) = vbNo Then Exit Sub

'Copy into Dispo List
    Application.ScreenUpdating = False
        'Dispo.Unprotect
        Worksheets("Calculations").Range("M16:AB16").Copy
        Dispo.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        'Dispo.Protect
    Application.ScreenUpdating = True

'Erase from Case List
    With Cases

    .Select
    .Range("C13:R13").ClearContents
    .Range("C13").Select

    End With

End If

End Sub

my Excel spreadsheet is a list of cases. There are 500 rows, and the case information ranges from columns C through R.

I created option buttons for each row, which allows me to "select" a case by clicking that option button. My VLOOKUP formula identifies the correct case in another sheet based on my selection.

Now I am trying to create a button that allows me to move a selected case from my spreadsheet onto another sheet. I know how to do this, but my method is extremely cumbersome because it requires me to enter the cell references for each row. There are 500 of them, so it would take a long time. Is there a way to programmatically expedite this?

Here is my way of achieving my desired result, but it takes too long. As you can see, I stopped after "ElseIf selection = 3" as I realized I would have to do this 500 times. I would rather not have to input 500 "ElseIf selection = " entries and change the cell references in the "Erase from Case List" section below. Any solutions?

Sub Archive_Case()

Dim selection As Integer

selection = Range("Calculations!A2").Value

Dim Workbook As Workbook 'This Workbook
Dim Cases As Worksheet 'Cases Worksheet
Dim Calculations As Worksheet 'Calculations
Dim Dispo As Worksheet 'Dispo

Set Workbook = ThisWorkbook
Set Cases = Workbook.Sheets("Cases")
Set Calculations = Workbook.Sheets("Calculations")
Set Dispo = Workbook.Sheets("Dispo")

If selection = 0 Then

    MsgBox "Select a case that you want to archive."

ElseIf selection = 1 Then

    If MsgBox("Do you really want to archive this case and remove it from this list?", vbYesNo) = vbNo Then Exit Sub

'Copy into Dispo List
    Application.ScreenUpdating = False
        'Dispo.Unprotect
        Worksheets("Calculations").Range("M16:AB16").Copy
        Dispo.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        'Dispo.Protect
    Application.ScreenUpdating = True

'Erase from Case List
    With Cases

    .Select
    .Range("C11:R11").ClearContents
    .Range("C11").Select

    End With

ElseIf selection = 2 Then

    If MsgBox("Do you really want to archive this case and remove it from this list?", vbYesNo) = vbNo Then Exit Sub

'Copy into Dispo List
    Application.ScreenUpdating = False
        'Dispo.Unprotect
        Worksheets("Calculations").Range("M16:AB16").Copy
        Dispo.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        'Dispo.Protect
    Application.ScreenUpdating = True

'Erase from Case List
    With Cases

    .Select
    .Range("C12:R12").ClearContents
    .Range("C12").Select

    End With

ElseIf selection = 3 Then

    If MsgBox("Do you really want to archive this case and remove it from this list?", vbYesNo) = vbNo Then Exit Sub

'Copy into Dispo List
    Application.ScreenUpdating = False
        'Dispo.Unprotect
        Worksheets("Calculations").Range("M16:AB16").Copy
        Dispo.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        'Dispo.Protect
    Application.ScreenUpdating = True

'Erase from Case List
    With Cases

    .Select
    .Range("C13:R13").ClearContents
    .Range("C13").Select

    End With

End If

End Sub

• excel
• vba

Share Improve this question Follow asked Nov 21, 2024 at 22:23 DocBrownDocBrown 311 silver badge11 bronze badge 1

• 1 If you use something like .Range("C10:R10").offset(selection).ClearContents you only need one block... I would not use a variable named selection though. – Tim Williams Commented Nov 21, 2024 at 22:23

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 3

No need for all of those cases:

Sub Archive_Case()
    'Ideally don't name variables with the same name as existing items/types
    '    like Selection, Workbook, etc
    Dim wb As Workbook, CaseNum As Long 'prefer long over integer
    Dim Cases As Worksheet, Calculations As Worksheet, Dispo As Worksheet
    
    Set wb = ThisWorkbook
    Set Cases = wb.Worksheets("Cases")
    Set Calculations = wb.Worksheets("Calculations")
    Set Dispo = wb.Worksheets("Dispo")
    
    CaseNum = Calculations.Range("A2").Value
    
    If CaseNum = 0 Then
        MsgBox "First select a case that you want to archive."
        Exit Sub
    Else
        If MsgBox("Do you really want to archive this case " & _
            "and remove it from this list?", vbYesNo) <> vbYes Then Exit Sub
               
        With Calculations.Range("M16:AB16") 'copy case info from the lookup range
            Dispo.Cells(Rows.Count, "C").End(xlUp). _
              Offset(1, 0).Resize(1, .Columns.Count).Value = .Value
        End With
        
        With Cases.Range("C10:R10").Offset(CaseNum) 'clear the case
            .ClearContents
            .Cells(1).Select
        End With
               
    End If

End Sub

Managing option buttons for each row is a bit of a chore though, so you could consider instead adding an "Archive" hyperlink on each row, then use that to trigger the archiving (use the Worksheet.FollowHyperlink event to run the copy/clear steps)

本文标签： Excel VBA ClearContents DynamicallyStack Overflow