How to code change on moving cell contents down one
Category: [Excel] Demo Available
How to code change on moving cell contents down one
Requirement:
The user needs help with a change to code. Currently it moves two cells of numbers (side by side) to the cell directly below it. I need it changed to move only the first cell down (in the cell range E5:E14 sample). The user does not need the code to delete the cell contents to the right of it (cell range F5:F14 sample). There could be one of more sets of numbers in the cell rage (in the sample there are two sets and both have to be moved down by one cell).
This is only a sample sheet and so please don’t hard code the code. The user needs to be able to change the cell locations in the code. The user has attached a sample Excel workbook with the expected result (please refer to the link below to gain access to the forum to obtain the file).
Code:
Sub MOVE1DOWN()
Dim n, sht As Worksheet, cell As Range, num, tmp, rngDest As Range
Set sht = ActiveSheet
n = sht.Range("J2")
For Each cell In sht.Range("E5:E14").Cells
tmp = cell.Offset(0, 1).Value
If cell.Value = n And tmp Like "*#-#*" Then
'get the first number
num = CLng(Trim(Split(tmp, "-")(0)))
Debug.Print "Found a positive result in " & cell.Address
'find the next empty cell in the appropriate row
Set rngDest = sht.Cells(num, sht.Columns.Count).End(xlToLeft).Offset(0, 1)
If rngDest.Column < 10 Then Set rngDest = sht.Cells(num, 10)
cell.Offset(0, 1).Copy rngDest
Rem Move the next row of cell contents to the next cell
In sht.Range(“F5:F14”).Cells
tmp = cell.Offset(0, 1).Value
If cell.Value = n And tmp Like "*#-#*" Then
Cells(irow + 1, icol).Insert Shift:=xlDown
Cells(irow, icol).Copy Cells(irow + 1, icol)
Cells(irow, icol).Clear
Exit For
End If
Next
Solution:
Code:
Sub MoveDownOne()
Dim cell As Range
Dim num1 As Long
Dim num2 As Long
For Each cell In Range("E5:E14")
If cell.Value Like "*#-#*" Then
num1 = CLng(Trim(Split(cell.Value, "-")(0)))
num2 = CLng(Trim(Split(cell.Value, "-")(1))) + 1
cell.Value = num1 & "-" & num2
End If
Next cell
Range("E5:E13").Cut
Range("E6").Select
ActiveSheet.Paste
Range("E5").Select
End Sub
Obtained from the OzGrid Help Forum.
Solution provided by Carim.
See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets
See also:
| How to protect VBA source code from view |
| How to use VBA Code in Excel to display a balloon |
| How to use VBA code to clear cells based on specific criteria |
| How to use VBA code - Find value from cell in different column and multiply by another cell |
| How to use VBA code to ccolour tabs based on tab/text number |
Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.