removing (swapping) blank rows in a range via VBA

RobbieC

Active Member
Joined
Dec 14, 2016
Messages
376
Office Version
  1. 2010
Platform
  1. Windows
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
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
My main problem is identifying the FIRST blank row and the NEXT row with data... I can swap them over using:

Code:
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
 
Upvote 0
How about
Code:
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
 
Upvote 0
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:

exampleData_After.jpg
 
Upvote 0
Are there any cells on the 2nd row that will always have a value?
 
Upvote 0
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)
 
Upvote 0
In that case how about
Code:
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
 
Upvote 0
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
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,100
Members
452,301
Latest member
QualityAssurance

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top