Solved

Adjustment to Macro when Clearing a Case

Posted on 2014-12-13
5
65 Views
Last Modified: 2014-12-15
I have a great piece of work that Glenn Ray (EE) did for me to help me with a change to a fairly advanced macro. I need one additional capability built into the macro on the attached WB.  

When you open it you will see a set of rows with the ability to click on the black box (E8......First Tab) and a checkmark will appear.  All selections will show up on the following tab automatically as you select rows.  What Glenn did for me is give me the ability to reverse the selection.  In other words, if I de-selected a row by clicking on a box already checked, it would remove it from the next tab.  

What I need help with is if a selection is removed, the other selections need to move up (so there are no gaps) and the 3 columns on the second tab are cleared/erased if a particular row on the first tab is deselected. -- That's it!

Your assistance is appreciated and "thank you" in advance.

B.
Copy-of-EE-Fix-Check-Marks-v4.xlsm
0
Comment
Question by:Bright01
  • 3
  • 2
5 Comments
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 40498422
the issue is that the 'UseCase' cells on Use_Case_Priority are references to Validation_DB.
yet the Factor Cells are hard coded.  I will see if amending the 'sumup' routine is possible
0
 
LVL 32

Accepted Solution

by:
Robberbaron (robr) earned 500 total points
ID: 40498425
try adding
        'now fix the Use_Priority sheet
        Dim ws As Worksheet, wscell As Range
        Set ws = ActiveWorkbook.Sheets("Use_Case_Priority")
        For Each wscell In ws.Range("B5..B10")
            If wscell.Value = "" Then
                'its empty so empty cells to right
                wscell.Offset(0, 1).Resize(1, 3).ClearContents
            End If
        Next wscell

Open in new window

to the bottom of the sumup routine.
Copy-of-EE-Fix-Check-Marks-v5.xlsm
0
 

Author Comment

by:Bright01
ID: 40498947
Like this?   I tried this but couldn't get it to work.............

Sub sumup()
    Const Input_Range = 5
    '3
    Const Output_Range = 800
    '17
    Const Output_CS = 7
    '18
    Const Output_CE = 1
    Const Input_CM = 5
   
    Dim O_R As Long
    'Output Row
    Dim I_R As Long
    'Input Row
    Dim Total As Double

    'Total
    '**** Clear the previous output ****
    With Worksheets("Validation_DB")
        .Range("G800:G812") = ""
    End With
    O_R = Cells(Rows.Count, Output_CS).End(xlUp).Row
    If O_R >= Output_Range Then
        'Column and Row Output
        Range(Cells(Output_Range, Output_CS), Cells(O_R, Output_CE)).ClearContents
    End If
    'Column Explanation
    O_R = Output_Range
   
    'Where the checkmark is
    I_R = Cells(Rows.Count, Input_CM).End(xlUp).Row
    If I_R >= Input_Range Then
        'Input row
        For I = Input_Range To I_R
            With Cells(I, Input_CM)
                If .Value = "P" Then
                    'Output results here
                    Sheets("Validation_DB").Cells(O_R, Output_CS).Value = .Offset(0, 2).Value
                    Sheets("Validation_DB").Cells(O_R, Output_CE).Formula = "=" & .Offset(0, 5).Address
                    Sheets("Validation_DB").Cells(O_R, Output_CE).NumberFormatLocal = _
                            "_(""$""* #,##0_);_(""$""* (#,##0);_(""$""* ""-""??_);_(@_)"
                    If Not IsError(.Offset(0, 5).Value) Then Total = Total + .Offset(0, 5).Value
                    O_R = O_R + 1
                End If
            End With
        Next
        Cells(Output_Range - 1, Output_CS).Value = "Total"
        With Cells(Output_Range - 1, Output_CE)
            .FormulaR1C1 = "=SUM(R[1]C:R[" & O_R & "]C)"
            .NumberFormatLocal = _
                    "_(""$""* #,##0_);_(""$""* (#,##0);_(""$""* ""-""??_);_(@_)"
        End With
    End If

'now fix the Use_Priority sheet
        Dim ws As Worksheet, wscell As Range
        Set ws = ActiveWorkbook.Sheets("Use_Case_Priority")
        For Each wscell In ws.Range("B5..B10")
            If wscell.Value = "" Then
                'its empty so empty cells to right
                wscell.Offset(0, 1).Resize(1, 3).ClearContents
            End If
        Next wscell



End Sub
0
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 40499844
not quite.
put my code 3 lines up, between End With , and End If.

you only want it to trigger if an update happens.

  see the workbook i uploaded also.
0
 

Author Closing Comment

by:Bright01
ID: 40500114
Excellent!!!  Thank you very much!  Works very well..... appreciate it.

B.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

919 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now