How to move first and last row of values

[Abdullah H]

Dear Community,

It's been years since I coded VBA, so I'm a bit rusty. Based on worksheet attached, I need help with a code that does the following:

For each test series N in column A:
- move the first row of values up to "Test Start" row (yellow color)
- move that last row of values down to "Test End" row (blue color)

Notes:
- "Test N Start" and "Test N End" rows are always blank
- no blanks in column A
- not all tests have a value (blank cells)
- number of columns is a variable
- number of rows is a variable

Thank you in advance!

 

[Hui]

Abdullah

Firstly, Welcome to the Chandoo.org Forums

This code should help

Sub MoveData()

Dim ws As Worksheet
Dim lr As Integer, lc As Integer
Dim i As Integer

Set ws = ThisWorkbook.Worksheets("Sheet1")
ws.Activate

lr = ws.Range("A" & Rows.Count).End(xlUp).Row
lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

For i = 2 To lr
  'Loop through all rows
  If Right(Cells(i, 1), 5) = "Start" Then
  'Find first row
    For j = i To lr Step 1
      If WorksheetFunction.CountA(Range(Cells(j, 2), Cells(j, lc))) > 0 Then
        ws.Range(Cells(j, 2), Cells(j, lc)).Cut ws.Range(Cells(i, 2), Cells(i, lc))
        Exit For
      End If
    Next j
 
  ElseIf Right(Cells(i, 1), 3) = "End" Then
  'Find last row
 
    For j = i To 2 Step -1
      If WorksheetFunction.CountA(Range(Cells(j, 2), Cells(j, lc))) > 0 Then
        ws.Range(Cells(j, 2), Cells(j, lc)).Cut ws.Range(Cells(i, 2), Cells(i, lc))
        Exit For
      End If
    Next j
  End If

Next

End Sub

or see attached file:

 

[Hui]

Abdullah

Please also note there is no need to Title a Thread *** Help Please ***

The fact you are asking a question means you need assistance

Please take a moment to read the site rules at: https://chandoo.org/forum/threads/new-users-please-read.294/
https://chandoo.org/forum/threads/new-users-please-read.294/