Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #1  
Old 09-19-2018, 10:46 AM
kevinbradley57 kevinbradley57 is offline Somehow getting extra blank rows with borders Windows 7 64bit Somehow getting extra blank rows with borders Office 2010 64bit
Advanced Beginner
Somehow getting extra blank rows with borders
 
Join Date: Jul 2017
Posts: 87
kevinbradley57 is on a distinguished road
Default Somehow getting extra blank rows with borders

I have a macro that retrieves data from an external spreadsheet, runs various edits on the data, removes duplicates, and then adds borders around the used range. Unfortunately, it also adds blank rows at the bottom of the spreadsheet and I can't figure out why it's doing that or how to get rid of them. Any help would be greatly appreciated. Yes, I know the code is a mess. It was cobbled together by a rookie (me) and evolved as columns were added. I would welcome any suggestions for making it cleaner.



Code:
Sub GetDaily()
   Dim wb As Workbook, src As Workbook
   Dim sht As Worksheet, cel As Range
   Dim lr As Long
 
Set sht = ThisWorkbook.ActiveSheet
'remove existing data
    Columns("A:A").Select
    Selection.ColumnWidth = 5
    Columns("B:B").Select
    Selection.ColumnWidth = 30
    Columns("C:C").Select
    Selection.ColumnWidth = 20
    Columns("D:D").Select
    Selection.ColumnWidth = 20
    Columns("E:E").Select
    Selection.ColumnWidth = 8
    Columns("F:F").Select
    Selection.ColumnWidth = 8
    Columns("G:G").Select
    Selection.ColumnWidth = 8
    Columns("H:H").Select
    Selection.ColumnWidth = 9
    Columns("J:J").Select
    Selection.ColumnWidth = 60
    Columns("K:K").Select
    Selection.ColumnWidth = 10.5
    Columns("L:L").Select
    Selection.ColumnWidth = 11
With sht.UsedRange.Offset(1)
   .Borders.LineStyle = xlNone
   .ClearContents
End With
'see if source is open
For Each wb In Application.Workbooks
   If wb.Name = "SearchResultsDaily " & Format(Date, "m.d.yy") & ".xls" Then
       Set src = wb
       Exit For
   End If
Next wb
'if yes copy data
If Not src Is Nothing Then
   src.Sheets(1).UsedRange.Offset(1).Copy
'if no display message and quit
Else
   MsgBox "Workbook   " & Chr(34) & "SearchResultsDaily " & _
           Format(Date, "m.d.yy") & ".xls" & Chr(34) & "   is not open."
   Exit Sub
End If
'paste the copied data
With sht
   .Cells(2, 1).PasteSpecial (xlPasteValues)
   'name sheet
'   .Name = Left(src.Name, Len(src.Name) - 4)
   ' E from F if blank
   For Each cel In Intersect(.Columns("E"), .UsedRange)
       If cel.Value = "" Then cel.Value = cel.Offset(, 1).Value
   Next cel
   'position the cursor for sorting
      .Cells(2, 5).Select
   'determine last row
   lr = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
With ActiveSheet
    .Range("A1:L" & .Cells(Rows.Count, 1).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlYes
End With
   With .Sort
       .SortFields.Clear
       .SortFields.Add Key:=Range("F2"), SortOn:=xlSortOnValues, Order:=xlAscending, _
                            DataOption:=xlSortTextAsNumbers
       .SetRange Range("A2:J" & lr)
       .Header = xlNo
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
   End With
End With
  Columns("A:L").Select
    With Selection
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
 
'   .Cells(1).Select
'End With
'stop the marching ants
Application.CutCopyMode = False
 
'Remove username from audit director names.
    Dim rng As Range
lr = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
Set rng = Union(Range("C1:C" & lr), Range("D1:D" & lr))
rng.Replace What:=" (*)", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _
                        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'Remove AUDIT- from AUDIT-XXXX in column A
    Columns("A:A").Select
    Selection.Replace What:="AUDIT-", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
    With Selection
        .HorizontalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
 
'Change Needs Improvement to IN and Satisfactory to Sat in column G.
    Columns("G:G").Select
    Selection.Replace What:="Needs Improvement", Replacement:="IN", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Satisfactory", Replacement:="Sat", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
'Put borders around new rows.
With ActiveSheet.UsedRange.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
With ActiveSheet.UsedRange.Font
        .Name = "Arial"
        .Size = 8
    End With
 
Range("A1").Select
ActiveWorkbook.SaveAs "Daily Plan Status " & Format(Date, "m.d.yy") & ".xlsm"
End Sub
Reply With Quote
 

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Template with background colors has extra blank page that will not delete. jspinelli27 Word 1 03-11-2018 02:27 PM
Section Break Inserts an Extra Blank Page Nathan8752 Word 3 12-09-2015 07:03 AM
Somehow getting extra blank rows with borders Delete blank rows between the two rows that contain data beginner Excel Programming 5 12-26-2014 12:29 AM
Extra lines in directroy when field is blank redzan Mail Merge 5 05-23-2014 06:40 PM
Somehow getting extra blank rows with borders Count rows and add blank rows accordingly Hoochtheseal Word VBA 1 01-29-2013 09:23 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 08:10 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft