I am building a tool where user-selected cell contents is moved around with arrow shapes.
The code below works great to move 1 or more group of adjacent cells down.
However, reversing the code seems tricky (+1 in offset does not work :-?)
Any idea?
Thank you,
Augustin
Sub Move_Up()
Selection.Cut
Selection.Offset(-1, 0).Select
Selection.Insert Shift:=xlDown
End Sub
supposing cells are to be moved around and overwritten ones are just shifted where moved ones once were, the code could be the following:
Sub MoveUp()
Selection.Rows(Selection.Rows.count + 1).Insert Shift:=xlDown
Selection.Rows(1).Offset(-1).Cut Selection.Rows(Selection.Rows.count + 1)
Selection.Rows(1).Offset(-1).Delete Shift:=xlUp
Selection.Offset(-1).Select
End Sub
Sub MoveDown()
Selection.Rows(1).Insert Shift:=xlDown
Selection.Rows(Selection.Rows.count).Offset(2).Cut Selection.Rows(1)
Selection.Rows(Selection.Rows.count).Offset(2).Delete Shift:=xlUp
Selection.Offset(1).Select
End Sub
If you want to move a Selected block of cells up by one row then:
Sub ShiftBlockUp()
Dim r As Range
Set r = Selection
Intersect(r(1).EntireRow, r).Offset(-1, 0).Delete Shift:=xlUp
End Sub
If you want to move a Selected block of cells down by one row then:
Sub ShiftBlockDown()
Dim r As Range
Set r = Selection
Intersect(r(1).EntireRow, r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
Related
I am attempting to create a new column on a different sheet and then copy data into that column.
Below is the code I have written. The first sub is a new column to the left and the second sub is the column to the right.
The insert column part is working. I hid a column and have a cell in there as a named range which I used to select in my macro. The data I want to copy is on the Input sheet and is named InputData.
Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
Sheets("Data").Activate
Sheets("Data").Range("DividerColumn").Select
Selection.EntireColumn.Offset(0, 0).Insert Shift:=xlToLeft
'Sheets("Input").Activate
'Range("InputData").Copy
'Sheets("Data").Activate
'ActiveCell offset maybe?
'Range().PasteSpecial xlPasteValues
Call sourceSheet.Activate
End Sub
Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
Sheets("Data").Activate
Sheets("Data").Range("DividerColumn").Select
Selection.EntireColumn.Offset(0, 1).Insert Shift:=xlToRight
Call sourceSheet.Activate
End Sub
Oh I didn't see your copy range. In that case this could probably work. I see you just got the answer, but this would be a good way to avoid select.
Sub copyToLeft()
Call doTheCopy(False)
End Sub
Sub CopyToRight()
Call doTheCopy(True)
End Sub
Private Sub doTheCopy(goRightIsTrue As Boolean)
With Sheets("Data").Range("DividerColumn").EntireColumn.Offset(0, IIf(goRightIsTrue, 1, 0))
.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
.Offset(0, -1).Value = Sheets("Input").Range("InputData").EntireColumn.Value
End With
End Sub
I found the solution by using an offset function. Below is my code. Hope this helps someone with a similar situation.
Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
Sheets("Data").Activate
Sheets("Data").Range("DividerColumn").Select
Selection.EntireColumn.Offset(0, 0).Insert
Shift:=xlToLeft
Sheets("Input").Activate
Range("InputData").Copy
Sheets("Data").Activate
Range("DividerColumn").Select
ActiveCell.Offset(0, -1).PasteSpecial
xlPasteValues
Call sourceSheet.Activate
End Sub
-1 in the offset function moves your active cell to the left one cell and then 1 moves it to the right. So once the column is created, either right or left, my macro goes and copies the information and then goes back to the sheet I want it to and selects my named range again and then it gets moved to the left and pastes my data.
I have recorded this macro in excel. The idea is to go through all rows (100)
and repeat the SUB. I think i figured the proper algorithm (I have basic Turbo Pascal knowlege).
Here is my algorithm:
Create a loop that is using a variable, i, for counting.
For i from 2 (we start from row 2, row 1 has headers) to 200 (even if we initially have 100 rows by the time the scrip will finish executing we will have doubled the amount of rows)
Do the sub
How do I make Rows("2:2") for example to reference the current value of i.
How do Rows("3:3") to use the value i+1.
How do I make Range("B2") to use the value B(i)
I am stuck with the loop and the proper syntax Please help. Also since I want to get deeper into the topic could you please suggest some good sources? I was not really interested in coding after during high school, but now I want to get deeper into the topic.
Sub Macro2()
Rows("2:2").Select
Selection.Copy
Rows("3:3").Select
Selection.Insert Shift:=xlDown
Range("B2").Select
Application.CutCopyMode = False
Selection.Cut
Range("A3").Select
ActiveSheet.Paste
End Sub
Something like this:
Sub Macro2()
Dim i As Long
For i = 100 To 2 Step -1
Rows(i).Copy
Rows(i + 1).Insert shift:=xlDown
Cells(i, 2).Cut Cells(i + 1, 1)
Next i
End Sub
I removed the .Select and .Activate It slows down the code. See HERE for good guidance on such.
When adding or subtracting rows it is best to iterate from bottom to top. The Step - 1 does that. It starts at row 100 and goes up till row 2.
Another note you will want to designate the sheet so that it looks at the correct sheet:
Sub Macro2()
Dim ws as Worksheet
Dim i As Long
Set ws = Sheets("Sheet1") 'Change to your sheet.
For i = 100 To 2 Step -1
ws.Rows(i).Copy
ws.Rows(i + 1).Insert shift:=xlDown
ws.Cells(i, 2).Cut ws.Cells(i + 1, 1)
Next i
End Sub
So I'm trying to work on a single file, go to each cell in column A on "Source" (from row 1 to last row holding data), place that value in cell C3 on "Destination", recalculate the workbook and save the file
I haven't gotten to save the file yet because I am stuck on looping. Can anybody help please?
Sub test()
Sheets("Source").Select
With ActiveSheet
Set r = Range("Employee #")
For n = 1 To r.Rows.Count
r.Cells(n, 1).Select
Selection.Copy
End With
Sheets("Destination").Select
Range("C3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next n
End Sub
Started VBA 7 days ago so I am trying to do my best here..
In further review you do not need the with block
Sub test()
with Sheets("Source")
Set r = .Range(.Range("A2"),.Range("A" &.row.count).end(xlup))'Change this to the column you want
end with
For n = 1 To r.Rows.count
r.Cells(n, 1).copy Sheets("Destination").Range("C3")
Application.CutCopyMode = False
Next n
End Sub
or all the slects for that matter. But now you can see that you are putting every value that you loop into one cell.
I would like to set up some code for copying some cells with check boxes
I have 30 checkboxes
I have copied the code below and modified it 30times
This is no doubt redundant
Each check box is on a row, the data it will copy is on the same row
When the checkbox is clicked the row data in the next cell will be copied and moved somewhere else
This data will be dumped somewhere below in the same worksheet
I tried creating the elseif statements, unfortunately they did not work
If ThisWorkbook.Worksheets(1).Shapes("Check Box 2").OLEFormat.Object.Value = 1 Then
Range("f2").Select
Selection.Cut
Sheets("Sheet1").Select
Range("f15").Select
ActiveSheet.Paste
Range("f15").Select
Selection.Insert Shift:=xlDown
End If
End Sub
If ThisWorkbook.Worksheets(1).Shapes("Check Box 3").OLEFormat.Object.Value = 1 Then
Range("f3").Select
Selection.Cut
Sheets("Sheet1").Select
Range("f15").Select
ActiveSheet.Paste
Range("f15").Select
Selection.Insert Shift:=xlDown
End If
End Sub
If ThisWorkbook.Worksheets(1).Shapes("Check Box 4").OLEFormat.Object.Value = 1 Then
Range("f4").Select
Selection.Cut
Sheets("Sheet1").Select
Range("f15").Select
ActiveSheet.Paste
Range("f15").Select
Selection.Insert Shift:=xlDown
End If
End Sub
It is very repetitive as you can see
Any advice on how I can write this code so it will be like a nested if statement
if checkbox 1 is true do this
if checkbox 2 is true do this
etc etc
[IMG]http://i44.tinypic.com/2db78dj.jpg[/IMG]
please advise thank you
Without knowing a little more about the workbook structure, this is the best I can come up with. THere is likely some sort of "relationship" between the CheckBoxes and the cell(s) that need to be operated on, which could allow you to use a formula or some other logic to determine the cells to cut/paste, rather than relying on If/Then or Case logic.
Sub Test()
Dim cb As Shape
Dim cutRange As Range
'## The destination doesn't change, so we put this outside the loop
' also make it a constant value:
Cosnt destRange As String = "F15"
'## Now, iterate over each checkbox control in the sheet:
For Each cb In ActiveSheet.Shapes
'## Make sure the shape is an xlCheckBox AND value = True/checked
If cb.FormControlType = xlCheckBox And cb.OLEFormat.Object.Value = 1 Then
'## Assign the cutRange based on the CheckBox name
Select Case cb.Name
Case "Check Box 2"
Set cutRange = Range("F3")
Case "Check Box 3"
Set cutRange = Range("F4")
Case "Check Box 4"
Set cutRange = Range("F5")
'etc.
'## You can add as many Case values as you need
End Select
'## One statement cuts & inserts:
cutRange.Cut Range(destRange)
Range(destRange).Insert Shift:=xlDown
End If
Next
End Sub
This question is in accordance to the following question:
Visual Basic move all other columns to create one long column B
I used the best answer:
sub ss()
Dim col As Range
For Each col In Worksheets("Sheet1").Columns
If (col.Column > 1 And col.Column < 171) Then
Range(col.Rows(1), col.Rows(15)).Select
Selection.Cut
'Select cell at bottom of A
ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste 'Paste
End If
Next col
End Sub
Now this works, but it tiles all of the columns in the excel sheet to one single column. What I want to do is do it only for the selected columns when running the macro not for the whole sheet.
Is that possible? How?
Like this?
Sub Sample()
Dim col As Range
For Each col In Selection.Columns
If col.Column > 1 And col.Column < 171 Then
Range(col.Rows(1), col.Rows(15)).Select
Selection.Cut
ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next col
End Sub