Macro to Move Data

[NANCY SKYES]

Hi


I have data located in 1 row across 4 columns in many different ranges, an example is:


cell C38 cell D38 cell E38 cell F38

10-18 1.00 2.00 3.00



This is only my second post and I think this is possible so here goes. I was looking for help to develop a macro that:


1) [FONT=Liberation Serif, Times New Roman, serif]Searches about 20 different ranges, C[/FONT]<code class="western">[FONT=Liberation Serif, Times New Roman, serif]20:C50,P20:P50,Z20:Z50,AE20:AE50 [/FONT]</code><code class="western">[FONT=Liberation Serif, Times New Roman, serif]with the same start line of 20 and the same end line of 50[/FONT]</code><code class="western">[FONT=Liberation Serif, Times New Roman, serif] (not all listed here, need macro to be hard coded to add/delete as necessary also, [/FONT]</code><code class="western">[FONT=Liberation Serif, Times New Roman, serif]I[/FONT]</code><code class="western">[FONT=Liberation Serif, Times New Roman, serif] have data above and below [/FONT]</code><code class="western">[FONT=Liberation Serif, Times New Roman, serif]all the [/FONT]</code><code class="western">[FONT=Liberation Serif, Times New Roman, serif]search ranges)[/FONT]</code>[FONT=Liberation Serif, Times New Roman, serif] [/FONT][FONT=Liberation Serif, Times New Roman, serif]for sets of numbers (such as 10-10, 20-1 etc). The numbers are always separated by a dash. Most cells in the ranges will be blank but there will always be data (a set of numbers) in at least 2 [/FONT][FONT=Liberation Serif, Times New Roman, serif]of the [/FONT][FONT=Liberation Serif, Times New Roman, serif]ranges. Other ranges may [/FONT][FONT=Liberation Serif, Times New Roman, serif]or may not[/FONT][FONT=Liberation Serif, Times New Roman, serif] be [/FONT][FONT=Liberation Serif, Times New Roman, serif]blank[/FONT][FONT=Liberation Serif, Times New Roman, serif]. [/FONT]


2) When the code finds a set of numbers I need it to move that set of numbers down to the cell directly below it. The issue here is if there is a set of numbers already in that cell that set of numbers must be moved first down by one cell. The issue is no cell should be overwritten by new data from the above cell. Also, I need the code to delete the contents in the three cells to the right of the found set of numbers (above that would be delete cells D38/E38/F38). The data in the 3 cells deleted is written by another macro I use.


3) The next request is that when the set of numbers gets moved down that only the 2^nd set of numbers would be increased by one (10-1 would become 10-2). Please see my sample data below.


4) I would also need the code to search for sets of numbers that have a 20 in the second number and move that set of numbers by two cells down and increase the last number by one. There is an empty row below all the sets of numbers that reach 20. An example would be 2-20 would become 2-21 two cells down from where it was found.


Additional information


- The sheet name is Sheet 1 and their is only one sheet in the workbook.
- Using Excel 2007.
- The search range cells are formatted as text.
- The write cells are formatted as general.


Sample data:


1) The code searches [FONT=Liberation Serif, Times New Roman, serif]C[/FONT]<code class="western">[FONT=Liberation Serif, Times New Roman, serif]20:C50,P20:P50,Z20:Z50,AE20:AE50[/FONT]</code>. The first found set of numbers is 10-18 in cell C38. The code would check the cell contents for any existing data first and then move the data in cell C38 to cell C39 and increase the last number by 1. The code would also clear contents in cells D38/E38/F38. The expected result is 10-39 in cell C39.


2) The second found set of numbers would be 9-20 in cell P40. The code would write 9-21 in cell P42, moving two cells down because of the last number being 20. The code would also clear contents in cells Q38/R38/S38. The expected result is 9-42 in cell P42.


I hope I’m clear but if you have any questions please ask so I can clarify any issue(s).


Thanks so much for all your help.




<style type="text/css">p { margin-bottom: 0.21cm; direction: ltr; color: rgb(0, 0, 0); }p.western { font-family: "Times New Roman", serif; font-size: 12pt; }p.cjk { font-family: "SimSun"; font-size: 12pt; }p.ctl { font-family: "Mangal"; font-size: 12pt; }code.western { font-family: "Liberation Mono", "Courier New", monospace; }code.cjk { font-family: "WenQuanYi Micro Hei Mono", monospace; }code.ctl { font-family: "Liberation Mono", "Courier New", monospace; }a:link { }</style>

 

[DanteAmor]

You missed several cases.


I guess there will be other cases you didn't mention. I hope to solve them, because it is getting more and more complicated.

Sub MoveData()
  Dim rng As Range, c As Range, nums As Variant, nvo As Variant, a() As Variant, dato As String
  Dim i As Long, j As Long, col As Long, ini As Long, fin As Long, nfin As Long, nini As Long
  Dim k As Long, hay As Long
  Set rng = Range("C20:C50,P20:P50,Z20:Z50")
  DoEvents
  For Each c In rng.Columns
    ini = c.Cells(1, 1).Row
    nini = ini - 1
    fin = c.Rows.Count + ini - 2
    nfin = fin + 1
    col = c.Cells(1, 1).Column
    'Cells(nfin, col).Resize(1, 3).Value = ""
    Cells(nfin, col).Value = ""
    a = c.Value
    For i = fin To ini Step -1
      dato = a(i - nini, 1)
      If InStr(1, dato, "-") > 0 Then
        nums = Split(dato, "-")
        nvo = nums(0) & "-" & nums(1) + 1
        If Val(nums(1)) = 20 Then
          hay = False
          For k = i + 2 To fin + 1
            If Cells(k, col).Value = "" Then
              Cells(k, col).Cut
              Cells(i + 1, col).Insert Shift:=xlDown
              Cells(i + 2, col).Value = nvo
              Cells(i + 2, col).Offset(-2, 1).Resize(2, 2).Value = ""
              nfin = nfin - 1
              Cells(i, col).Value = ""
              hay = True
              Exit For
            Else
              
            End If
          Next k
          If hay = False Then
            If i = fin - 1 Then
              Cells(i + 2, col).Value = nvo
              Cells(i + 2, col).Offset(-2, 1).Resize(2, 2).Value = ""
              nfin = nfin - 1
              Cells(i, col).Value = ""
              Cells(i + 1, col).Value = ""
            Else
              If i = fin Then
                Cells(i, col).Value = ""
              End If
            End If
          End If
        Else
          Cells(i + 1, col).Value = nvo
          Cells(i + 1, col).Offset(-1, 1).Resize(1, 2).Value = ""
          nfin = nfin - 1
          Cells(i, col).Value = ""
        End If
      End If
    Next i
  Next c
End Sub

 

[NANCY SKYES]

I just finished testing your code and it works perfectly. It’s just amazing to have code like this and will save me so much time you have no idea. I’m not sure if you also do paid VBA work but I would highly recommend him. Dante is able to work with very inexperienced people and come with the perfect solution to the problem. I think he is one the best they have volunteering at Mr. Excel.

Nancy Skyes – August 20, 2019
<style type="text/css">pre { direction: ltr; color: rgb(0, 0, 0); }pre.western { font-family: "Liberation Mono", "Courier New", monospace; }pre.cjk { font-family: "WenQuanYi Micro Hei Mono", monospace; }pre.ctl { font-family: "Liberation Mono", "Courier New", monospace; }p { margin-bottom: 0.21cm; direction: ltr; color: rgb(0, 0, 0); }p.western { font-family: "Times New Roman", serif; font-size: 12pt; }p.cjk { font-family: "SimSun"; font-size: 12pt; }p.ctl { font-family: "Mangal"; font-size: 12pt; }a:link { }</style><style type="text/css">pre { direction: ltr; color: rgb(0, 0, 0); }pre.western { font-family: "Liberation Mono", "Courier New", monospace; }pre.cjk { font-family: "WenQuanYi Micro Hei Mono", monospace; }pre.ctl { font-family: "Liberation Mono", "Courier New", monospace; }p { margin-bottom: 0.21cm; direction: ltr; color: rgb(0, 0, 0); }p.western { font-family: "Times New Roman", serif; font-size: 12pt; }p.cjk { font-family: "SimSun"; font-size: 12pt; }p.ctl { font-family: "Mangal"; font-size: 12pt; }a:link { }</style>

 

[DanteAmor]

I just finished testing your code and it works perfectly. It’s just amazing to have code like this and will save me so much time you have no idea. I’m not sure if you also do paid VBA work but I would highly recommend him. Dante is able to work with very inexperienced people and come with the perfect solution to the problem. I think he is one the best they have volunteering at Mr. Excel.

Nancy Skyes – August 20, 2019
<style type="text/css">pre { direction: ltr; color: rgb(0, 0, 0); }pre.western { font-family: "Liberation Mono", "Courier New", monospace; }pre.cjk { font-family: "WenQuanYi Micro Hei Mono", monospace; }pre.ctl { font-family: "Liberation Mono", "Courier New", monospace; }p { margin-bottom: 0.21cm; direction: ltr; color: rgb(0, 0, 0); }p.western { font-family: "Times New Roman", serif; font-size: 12pt; }p.cjk { font-family: "SimSun"; font-size: 12pt; }p.ctl { font-family: "Mangal"; font-size: 12pt; }a:link { }</style><style type="text/css">pre { direction: ltr; color: rgb(0, 0, 0); }pre.western { font-family: "Liberation Mono", "Courier New", monospace; }pre.cjk { font-family: "WenQuanYi Micro Hei Mono", monospace; }pre.ctl { font-family: "Liberation Mono", "Courier New", monospace; }p { margin-bottom: 0.21cm; direction: ltr; color: rgb(0, 0, 0); }p.western { font-family: "Times New Roman", serif; font-size: 12pt; }p.cjk { font-family: "SimSun"; font-size: 12pt; }p.ctl { font-family: "Mangal"; font-size: 12pt; }a:link { }</style>

Hello Nancy,
I don't work with VBA, I only learned it to help in the forums.


It is a pleasure to help you. I appreciate your kind comments.