Change of Macro

bloubul

Member
Hi All
I have the following macro, which in itself is a brilliant piece of work.
What I would like to know is, will it be possible to make a few changes to the macro so that it still deletes every nth row but only “X” number of cells to the left as indicated in yellow, the range will get longer as more draws are added. All the current message boxes must still be displayed. See the attached spreadsheet.

Here is the macro:
Option Explicit
Sub DeleteRow()
Dim EndRow, CheckRows, I, StartRow, StepRow
StartRow = Application.InputBox _
("Enter which row is the first to be removed." & Chr(10), _
"Rows to delete - Start point", , , , , , 1)
If TypeName(StartRow) = "Boolean" Then
Exit Sub
End If

StepRow = Application.InputBox _
("Enter increment of n-th row to delete," & Chr(10) & _
"i.e. 2 = every other, 3 every third?" & Chr(10), _
"Rows to delete - Step", , , , , , 1)
If TypeName(StepRow) = "Boolean" Or StepRow <= 1 Then
MsgBox "Sorry, do not remove every row with this code."
Exit Sub
End If

EndRow = Application.InputBox _
("Enter which row is the last to be removed." & Chr(10), _
"Rows to delete - End point", , , , , , 1)
If TypeName(EndRow) = "Boolean" Then
Exit Sub
End If

CheckRows = MsgBox("You want to remove rows in steps of " & StepRow _
& ", starting with row " & StartRow & " and ending with row " _
& EndRow & ". Correct?", vbYesNo, "Verify data!")
If CheckRows = vbYes Then
I = StartRow
Do Until I > EndRow
Rows(I).Select
Selection.Delete Shift:=xlUp
I = I + StepRow - 1
Loop
Else
End If
Application.Goto Reference:="R1C1"
End Sub


Here are the link:
https://www.mediafire.com/file/cdq9198e5ayix66/Book1.xlsx/file

BlouBul :cool:
 

Frank

Member
Hi All

What I would like to know is, will it be possible to make a few changes to the macro so that it still deletes every nth row but only “X” number of cells to the left as indicated in yellow,
BlouBul :cool:

I'm not quite sure what you really mean since you can't both delete a row whilst at the same time only deleting X cells along the row you have just deleted. That doesnt make sense.
Did you mean clear the contents of the selected rows instead of deleting them?
I've modified the macro to just clear X cells from the left on the selected rows and have given the macro a new name.
You can either run the original macro to delete rows as normal or run this one to just clear X cells on the rows instead.
Was this what you wanted ?


Option Explicit ' you only need this once per module sheet

Sub ClearCells()
Dim EndRow, CheckRows, I, StartRow, StepRow, numcells
StartRow = Application.InputBox _
("Enter which row is the first to be edited." & Chr(10), _
"Rows to edit - Start point", , , , , , 1)
If TypeName(StartRow) = "Boolean" Then
Exit Sub
End If

StepRow = Application.InputBox _
("Enter increment of n-th row to edit," & Chr(10) & _
"i.e. 2 = every other, 3 every third?" & Chr(10), _
"Rows to edit - Step", , , , , , 1)
If TypeName(StepRow) = "Boolean" Or StepRow <= 1 Then
MsgBox "Sorry, do not edit every row with this code."
Exit Sub
End If

EndRow = Application.InputBox _
("Enter which row is the last to be edited." & Chr(10), _
"Rows to edit - End point", , , , , , 1)
If TypeName(EndRow) = "Boolean" Then
Exit Sub
End If


numcells = Application.InputBox _
("Enter how many cells to be cleared on each row.")
If TypeName(numcells) = "Boolean" Then
Exit Sub
End If

CheckRows = MsgBox("You want to edit rows in steps of " & StepRow _
& ", starting with row " & StartRow & " and ending with row " _
& EndRow & " clearing " & numcells & " cells per row. Correct?", vbYesNo, "Verify data!")
If CheckRows = vbYes Then
I = StartRow
Do Until I > EndRow

Range("a1").Offset(I - 1, 0).Resize(, numcells).Select
Selection.ClearContents
I = I + StepRow + 1
Loop
Else
End If
Application.Goto Reference:="R1C1"
End Sub
 

bloubul

Member
Frank

Thank you for the macro, it is a great macro to clear any cell(s) when you
have made mistakes. Unfortunately it does not do what I'm looking for.

This is what I do manually.
1. I high light all the cells from A:G as indicated in yellow.
2. Than I select Delete, that select delete cells, than shift cells
left.
3. When I say OK, it shift all the high lighted cells left and move all
the cells in H:M (in this example) which is in line with high lighted
cells to A:G.
4. When done it forms a complete record for you, like in A1:G22.

That's why I thought that the Insert Row macro will be easy to tweak to shift
the high lighted cells left and in the same movement move the cells in H:M
left to A:G


BlouBul :cool:
 

Frank

Member
Frank

Thank you for the macro, it is a great macro to clear any cell(s) when you
have made mistakes. Unfortunately it does not do what I'm looking for.

This is what I do manually.
1. I high light all the cells from A:G as indicated in yellow.
2. Than I select Delete, that select delete cells, than shift cells
left.
3. When I say OK, it shift all the high lighted cells left and move all
the cells in H:M (in this example) which is in line with high lighted
cells to A:G.
4. When done it forms a complete record for you, like in A1:G22.

That's why I thought that the Insert Row macro will be easy to tweak to shift
the high lighted cells left and in the same movement move the cells in H:M
left to A:G


BlouBul :cool:

In that case this is what I suggest you do:-

look for this part of the modified macro:-

Range("a1").Offset(I - 1, 0).Resize(, numcells).Select
Selection.ClearContents
I = I + StepRow + 1


Delete the line that says:- Selection.ClearContents

replace it with :- Selection.Delete Shift:=xlToLeft

so it looks like:-

Range("a1").Offset(I - 1, 0).Resize(, numcells).Select
Selection.Delete Shift:=xlToLeft
I = I + StepRow + 1

That should do it.
I suggest you rename it

Sub MoveRowsLeft()

As that is what it is actually doing,

Good luck,
Frank
 

Sidebar

Top