Help with Code

Topic

New Reply

Hi All

I need some help with this code. I’d like to be able to multi select various cells in row 7 and get the code to select the respective columns. Also it appears that code only selects the column to the last cell with content, I’d like it to select the column/s to say row 500

Sub SelectColumn()
‘Updateby20140510
Dim xColIndex As Integer
Dim xRowIndex As Integer
xIndex = Application.ActiveCell.Column
xRowIndex = Application.ActiveSheet.Cells(Rows.Count, xIndex).End(xlUp).Row
Range(Cells(7, xIndex), Cells(xRowIndex, xIndex)).Select
‘Selection.Delete Shift:=xlToLeft
End Sub

I hope that makes sense – any help/suggestions would be much appreciated

Regards

Reply | Quote

Replies

Your code starts in the active column. How do you determine what the “respective columns” are?

cheers, Paul

Reply | Quote

Hi Paul

I was thinking of the shift click on various cells along row 7 and these would then determine what the “respective columns” are.

I hope that makes sense

Regards

Reply | Quote

Hi verad
Do you mean a continuous range as in Shift+Click or discontinuous with control +click?

If a continuous selection then what about something like this as something different.
You pas in the starting cell, columnOffset and rows required.
If it looks likely then some tidying up is required.

Code:

Sub main()
    defineSelection "A7", 5, 100
End Sub

Sub defineSelection(rStart, colOffset, rowCount)
    Range(rStart).Select
    Range(ActiveCell, ActiveCell.Offset(0, colOffset)).Select
    Range(Selection, Selection.Offset(rowCount, 0)).Select
End Sub

Cheers
Geof

Reply | Quote

Thanks Geof

Sorry I meant discontinuous with control +click.

Looks like your code is pretty close – just needs to take into account the discontinuous with control +click cell selection and then selecting (and deleting) the respective column/s.

Cheers

Reply | Quote

Something like this?

Code:

Sub SelectColumn()
    Dim rArea                 As Range
    Dim rSel                  As Range
    For Each rArea In Selection.Areas
        If rSel Is Nothing Then
            Set rSel = rArea.EntireColumn.Resize(500)
        Else
            Set rSel = Union(rSel, rArea.EntireColumn.Resize(500))
        End If
    Next rArea
    rSel.Select
    'rsel.Delete Shift:=xlToLeft
End Sub

Reply | Quote

Thanks Rory – that looks very close also.

I’ve attached a smaple of the spread sheet to give you (and any others) a better idea of what I’m tring to get the code to achieve.

I’ve highlited Cells H2, J2 & L2 as I would using the discontinuous with control +click cell selection.

I’d like the code to delete the entire column including the cell selections.

Hope this helps

Reply | Quote

Verada,

A slight twist. This code will append the selection of the columns as you select any cell in row 7. Click any cell in any other row to clear the selection.

Place in the worksheet module:

Code:

Private strng As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row = 7 Then
    col = Target.Column
    If strng = “” Then
        strng = Range(Cells(1, col), Cells(500, col)).Address
    Else:
        strng = strng & “,” & Range(Cells(1, col), Cells(500, col)).Address
    End If
    Application.EnableEvents = False
        Range(strng).Select
    Application.EnableEvents = True
Else:
    strng = “”
End If
End Sub

HTH,
Maud

Reply | Quote

Hi Maud,

Sorry I don’t really get this one:confused:

What do you mean append the selection?

Thanks again for your help

Regards

Reply | Quote

I’ve highlited Cells H2, J2 & L2 as I would using the discontinuous with control +click cell selection. I’d like the code to delete the entire column including the cell selections.

Verada,

If you want to delete the columns as you select instead of having to manually run a macro, place this code in the worksheet module. If you select any cell in row 2, the column of the section will be deleted. Continue to delete as many columns as needed

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Row = 2 Then
        Target.EntireColumn.Delete
    End If
End Sub

Maud

Reply | Quote

Thanks Maud

That look really good, only issue is that I need to delete the column including row 2 but keep the row 1 as it was.

I guess I wasn’t clear when I indicated “Id like the code to delete the entire column including the cell” sorry about that.

Also, can is there anyway that the normal “Undo” option is available in case a column is deleted in error?

Your assistance is very much appreciated

Regards

Reply | Quote

You’ll lose the undo stack whenever you run code that alters the sheet.

What exactly do you mean by deleting the column? Do you mean just clearing the contents or actually deleting the cells? If the latter, which way should cells shift – up or left – to fill the space?

Reply | Quote

Hi Rory, Thanks for the reply

May need to include a message in the code like “are you sure…?”
Sorry I want very clear in the deleting column – what I’m after is the column from the cell you select, say A7, all cell (including A7) down to say 500 are selected and the and a shift left happens to fill the space.

Hope that helps

Regards

Reply | Quote

I’d like the code to delete the entire column including the cell selections.

I need to delete the column including row 2 but keep the row 1 as it was.

what I’m after is the column from the cell you select, say A7, all cell (including A7) down to say 500 are selected and the and a shift left happens to fill the space.

Verada,

I have overcome the “Undo” issue by having the code store the column prior to deleting the data making it retrievable. But I am confused exactly what you want to delete. Can you clarify?

Maud

Reply | Quote

Hi Maud – Thanks again for your help.

Sorry I’ll try to clarify.

Lets say I need to remove all the cells from A7 to A500 (but leave A1 – A6 as they are). I click in A7 that highlights all cells to A500 (but could be any column/s) and the shift left would occur. This is the code from the macro I recorded – Selection.Delete Shift:=xlToLeft

I hope that helps

Much appreciated.

Regards

Reply | Quote

Thanks Verada for clarifying. Below is the code that will do the following. If you click on any cell in row 7, the cells in that column (from rows 7-500) will be deleted and a shift left would occur. If a mistake was made, running the “reset” routine will place the deleted cells back by shifting to the right and insert.

In the attached modified version of your worksheet, I have set the key combination of Ctrl-z to undo the delete process.

HTH,
Maud

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
    If Target.Count > 1 Then Exit Sub
    If Target.Row = 7 Then
        Dim rng As Range, cell As Range
        col = Target.Column
        nme = ActiveSheet.Name
        num = ActiveSheet.Index
        Set rng = Range(Cells(7, col), Cells(500, col))
        rng.Copy
        With Worksheets(“Hidden”)
            .Visible = True
            .Select
            .Range(“A1”).Select
            ActiveSheet.Paste
            .Range(“B1”) = nme
            .Range(“C1”) = rng.Address
            .Visible = xlVeryHidden
            Worksheets(Index).Select
        End With
        rng.Delete Shift:=xlToLeft
    End If
Application.ScreenUpdating = True
End Sub


Public Sub reset()
Application.ScreenUpdating = False
On Error GoTo errorhandler
    With Worksheets(“Hidden”)
        .Visible = True
        nme = .Range(“B1”)
        num = .Range(“C1”)
        .Select
        .Range(“A1:A493”).Copy
        Application.EnableEvents = False
        Worksheets(nme).Select
        Range(num).Select
        With Selection
            .Insert Shift:=xlToRight
            .Item(1).Select
        End With
        .Visible = xlVeryHidden
        Application.EnableEvents = True
    End With
Application.ScreenUpdating = True
Exit Sub
errorhandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Reply | Quote

Hi Maud – thanks for the Code. Sorry about the delay in getting back to you on this but I’ve been out of town for the last few days.

I’ve plugged it into the actual spreadsheet and ran the code and received an Run-time error ‘9’: subscript out of range on “With Worksheets(“Hidden”)”

Any idea what needs to be done to fix this error.

Regards

Reply | Quote

Verada,

Create a sheet called Hidden. That is where the deleted cells and their format get written to so that they can be recalled with the reset function (undo)

Reply | Quote

Thanks Maud – included a sheet called Hidden and Worksheet_SelectionChange works just fine ( I should have worked that one out – my bad!)

However I get an error “beep” when I hit the Ctrl-z to undo the delete process – any idea what might be causing this or am I doing something wrong

Regards

Reply | Quote

Try just running the reset routine through the macro button on the Developer tab. If all is OK then Perhaps that key combination is assigned to another task. Try assigning something like Ctrl-q to the reset macro

Developer Tab > Macros button > Select reset macro in large list box> Options > press the q key> OK > “X” to close.

You might also try assigning the reset macro to a form button.

Maud

Reply | Quote

Hi Maud – I worked out what the problem is (but not the solution unfortunately)

Sometimes the spreadsheet may have more than one tab (like “Worksheet”, “Worksheet 1”, “Worksheet 2”, etc)

So the reset routine works fine in “Worksheet” but not the others.

Is it a relevantly some task to be able to recover the data back to the Worksheet it came from or would it be a better option to include a message “Are you sure you want to delete this record” ?

Thanks for your assistance once again.

Regards

Reply | Quote

Ok great – thanks for your help

Much appreciated

Reply | Quote

Verada,

If you want the code to be usable for any sheet then apply the following changes:

Remove the existing code from the worksheet module.

In the worksheet module for each sheet you wanted to apply the behavior to, enter this code:

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    DelCells ActiveSheet.Index
End Sub

In a standard module, enter the following code:

Code:

Public Sub DelCells(num)
Application.ScreenUpdating = False
    With Worksheets(num)
        If Selection.Count > 1 Then Exit Sub
        If Selection.Row = 7 Then
            Dim rng As Range, cell As Range
            col = Selection.Column
            nme = ActiveSheet.Name
            Set rng = .Range(.Cells(7, col), .Cells(500, col))
            rng.Copy
            With Worksheets(“Hidden”)
                .Visible = True
                .Select
                .Range(“A1”).Select
                ActiveSheet.Paste
                .Range(“B1”) = nme
                .Range(“C1”) = rng.Address
                .Visible = xlVeryHidden
                Worksheets(num).Select
            End With
            rng.Delete Shift:=xlToLeft
        End If
    End With
Application.ScreenUpdating = True
End Sub

Public Sub reset()
Application.ScreenUpdating = False
On Error GoTo errorhandler
    With Worksheets(“Hidden”)
        .Visible = True
        nme = .Range(“B1”)
        num = .Range(“C1”)
        .Select
        .Range(“A1:A493”).Copy
        Application.EnableEvents = False
        Worksheets(nme).Select
        Range(num).Select
        With Selection
            .Insert Shift:=xlToRight
            .Item(1).Select
        End With
        .Visible = xlVeryHidden
        Application.EnableEvents = True
    End With
Application.ScreenUpdating = True
Exit Sub
errorhandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Reply | Quote

Thanks Maud,

Thanks looks just right.

Thanks you again for all you help, very much appreciated

Regards

Reply | Quote