Ensuring blanks cells are truly blank and are not picked up by VBA code finding last row

[aldousjg]

Hi all,

I've encountered a problem in a report I am building where the VBA code applying borders to a range ending at the last row of data picks up many rows that are not 'truly blank' underneath the last data value.

Data is being populated with this formula which correctly returns "" if there is no match:

=IFERROR(INDEX('ACP Data'!$A:$A,MATCH('Prepared Data'!$A2,'ACP Data'!$D:$D,0),1),"")

The data being fed into this is not a set number of rows, so I have applied this formula all the way down to row 5000 to ensure all data is captured.

This data is then copied into my report sheet using the following VBA code:

Sheets("Report Data").Activate

    Sheets("Report Data").Range("G2").Select
    Range(Selection, Cells(Rows.Count, "G").End(xlUp)).Select

    Selection.Copy
  
    Sheets("Report").Activate
  
    Sheets("Report").Range("C6").Select
  
    ActiveCell.PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True

Then a border is applied to all data in the report with this VBA code. The intention is for it to only go down to the last data row (row 1176 with my current data) but it is actually going down to row 5004 which I assume is due to the index formula going down to row 5000:

Dim rngBottomRowStart       As Range
    Dim rngBottomRowEnd         As Range
    Dim rngDataUpperLeftCell    As Range
    Dim dataRange1              As Range

    Set rngDataUpperLeftCell = Sheets("Report").Range("C5")
 
With rngDataUpperLeftCell
        Set rngBottomRowStart = Sheets("Report").Cells(.End(xlDown).Row, .Column)
        Set rngBottomRowEnd = Sheets("Report").Cells(rngBottomRowStart.Row, .End(xlToRight).Column)
    End With
  
    Set dataRange1 = Sheets("Report").Range(rngDataUpperLeftCell, rngBottomRowEnd)
  
    With dataRange1.Borders
    .LineStyle = xlContinuous
    .ColorIndex = 1
    .Weight = xlThin
    End With

Is there a way of ensuring that the borders only go down to the actual last data row?

Please let me know if you need any more info! Thanks in advance.

 

[Fluff]

Try adding this to your initial code

   Sheets("Report").Range("C6").Select
   ActiveCell.PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True
   With Sheets("Report")
      With .Range("C6", .Range("C" & Rows.Count).End(xlUp))
         .Value = .Value
      End With
   End With

 

[MARK858]

Try

Sheets("Report").Columns("C").Find("*", , xlValues, , xlByRows, xlPrevious).Row

instead of

Sheets("Report").Cells(.End(xlDown).Row

Btw, you don't need (want to) to use Select to work with ranges

 

[aldousjg]

Hi both,

I have tried Fluff's code suggestion and when applying borders they now go down to row 11 instead of row 5004. I cannot share my actual data as it is confidential but I have added in some random values to show here:

All columns can have blanks at any point and be correct - I need my borders to go down to the last row with data in at least 1 column.

I guess I need to amend my borders code which is this:

Dim rngBottomRowStart As Range
Dim rngBottomRowEnd As Range
Dim rngDataUpperLeftCell As Range
Dim dataRange As Range

Set rngDataUpperLeftCell = Sheets("Report").Range("C5")

With rngDataUpperLeftCell
Set rngBottomRowStart = Sheets("Report").Cells(.End(xlDown).Row, .Column)
Set rngBottomRowEnd = Sheets("Report").Cells(rngBottomRowStart.Row, .End(xlToRight).Column)
End With

Set dataRange = Sheets("Report").Range(rngDataUpperLeftCell, rngBottomRowEnd)

With dataRange.Borders
.LineStyle = xlContinuous
.ColorIndex = 1
.Weight = xlThin
End With

Any ideas? Thanks again.

 

[MARK858]

See post number 3

 

[aldousjg]

Hi Mark858,

I've copied your suggestion into my code as below:

With rngDataUpperLeftCell
Set rngBottomRowStart = Sheets("Report").Columns("C").Find("*", , xlValues, , xlByRows, xlPrevious).Row, .Column
Set rngBottomRowEnd = Sheets("Report").Cells(rngBottomRowStart.Row, .End(xlToRight).Column)
End With

If I leave the .Column at the end I get an error saying expected end of statement. If I take the .Column out and run the code I get an object required error.

What am I doing wrong here?

Thanks,

 

[MARK858]

You need to remove the .Row ln rngBottomRowStart.Row and the , .Column also the Set =.

I'll write it for you when I get back in.

 

[MARK858]

Try the below and see if it does what you want (I've played with it a bit just as I think it is clearer)

    Dim rngBottomRowEnd         As Range
    Dim rngDataUpperLeftCell    As Range
    Dim dataRange1              As Range
    Dim LastRow                 As Long
    Dim LastColumn              As Long

    Set rngDataUpperLeftCell = Sheets("Report").Range("C5")
 
    LastRow = Sheets("Report").Columns("C").Find("*", , xlValues, , xlByRows, xlPrevious).Row
    LastColumn = Sheets("Report").Rows(rngDataUpperLeftCell.Row & ":" & LastRow).Find("*", , xlValues, , xlByColumns, xlPrevious).Column
        
    Set rngBottomRowEnd = Sheets("Report").Cells(LastRow, LastColumn)
   
  
    Set dataRange1 = Sheets("Report").Range(rngDataUpperLeftCell, rngBottomRowEnd)
  
    With dataRange1.Borders
        .LineStyle = xlContinuous
        .ColorIndex = 1
        .Weight = xlThin
    End With

 

[aldousjg]

Thank you, that works perfectly!

 

[MARK858]

You're welcome