removing (swapping) blank rows in a range via VBA

[RobbieC]

Hi there, I have a sheet which is full of data. Within the sheet, there is a particular range with data (D10:J29) - 20 rows

There are 10 records in this range, 2 rows for each record. These records are entered via a userform and should start at D10 and then the second record would be recorded at D12 etc.

However, sometimes the records are not entered in order, ie a user might add a record in D14 after D10 therefore leaving a blank row (double row) at D12

What I'm looking to do (via VBA) is to scan through the range and replace any blank row(s) with the next record (if there is one). There is data stored beneath this range, so it's not just a case of 'remove blank rows' as this will affect the data beneath. I think it's a case of 'swapping' the rows of data rather than 'deleting'...

I started to write a subroutine, but it started to become mechanical and overly complicated. I thought there must be a cleverer way to go about it....

I have uploaded an example 'data' sheet to my server which can be found here: https://bluecustard.co.uk/exampleData.xlsm

If you can point me in the right direction, I'd be very grateful. My head is spinning

Cheers. Rob

 

[RobbieC]

My main problem is identifying the FIRST blank row and the NEXT row with data... I can swap them over using:

Sub swapRecords()


      Dim Range1 As Variant, Range2 As Variant
      Range1 = Worksheets("Sheet1").Range("D14:J15")
      Range2 = Worksheets("Sheet1").Range("D22:J23")
      Worksheets("Sheet1").Range("D14:J15") = Range2
      Worksheets("Sheet1").Range("D22:J23") = Range1


End Sub

 

[Fluff]

How about

Sub RobbieC()
   Dim i As Long, Rw As Long
   Dim Ar As Areas
   
   Set Ar = Range("E10:E29").SpecialCells(xlConstants).Areas
   Rw = Ar(1).Offset(Ar(1).Count).Row
   For i = 2 To Ar.Count
      With Ar(i).Offset(, -1).Resize(, 7)
         .Copy Range("D" & Rw)
         Rw = Rw + Ar(i).Count
         .ClearContents
      End With
   Next i
End Sub

 

[RobbieC]

Hi Fluff, thanks for having a look at this for me. It almost worked!

It works completely if there is a value in every cell in the row, but if column E doesn't have anything in the 2nd row (which sometimes it hasn't) the next row covers up the 2nd row

Also, this only works where the blank cells are AFTER the first.

Below are the before and after screenshots for this situation so that I can show you more easily:

 

[Fluff]

Are there any cells on the 2nd row that will always have a value?

 

[RobbieC]

hrm, I don't think so... it's all down to user input as to what goes in the record...

The only guaranteed value is that of D10, D12.... D26, D28

There might be nothing else at all in the record apart from this single value.... sorry 'bout that (I should have mentioned it earlier)

 

[Fluff]

In that case how about

Sub RobbieC()
   Dim i As Long, Rw As Long
   Dim Ar As Areas
   
   Set Ar = Range("D10:D29").SpecialCells(xlConstants).Areas
   Rw = 10
   For i = 1 To Ar.Count
      If Ar(i).Row <> Rw Then
         With Ar(i).Resize(2, 7)
            .Copy Range("D" & Rw)
            .ClearContents
         End With
      End If
      Rw = Rw + 2
   Next i
End Sub

 

[RobbieC]

Amazing! Fluff, you are a star!

Thanks very much! The code is sooooo much more elegant than anything I could put together!

Thanks very much once again!

Rob

 

[Fluff]

Glad to help & thanks for the feedback