combining VBA code creating bugs

[Enzo_Matrix]

I use several subs for the file I maintain and an odd bug has started happening despite no change to the code. The rows that have data in them are supposed to be underlined as there are 10 columns of data and when it's printed out it is easier to read.

The issue is that there are blank rows below my tables that are being underlined and the number of rows increases each time I run my sub, despite the contents being cleared each time the "Sub FilterCopy()" is run.

This is designed to underline rows that have data in them using the date column as a point of reference.

'Underlining cells based on date range    
    With Range("A5:I100").SpecialCells(xlConstants).Borders(xlBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With

This filters my main data sheet and then copies the information into the various sheets I have established.

Sub FilterCopy()   
   Dim Ary As Variant
   Dim i As Long
   Dim Sht As Variant
     
   Ary = Array("Weld", "Composite", "Rubber", "Repairs")
   For Each Sht In Ary
      Sheets(Sht).UsedRange.ClearContents
   Next Sht
   With Sheets("Data")
      If .AutoFilterMode Then .AutoFilterMode = False
      For i = 0 To UBound(Ary)
         .Range("A4").AutoFilter 1, Ary(i)
         On Error Resume Next
         .UsedRange.Offset(1).SpecialCells(xlVisible).Copy Sheets(Ary(i)).Range("A" & Rows.Count).End(xlUp).Offset(4)
         On Error GoTo 0
      Next i
      .AutoFilterMode = False
   End With
    
End Sub

There is a lot more to the subs I am using, but I think these two are the main parts that may be causing an issue. I can post the entire code if need be.

Please help if possible.

 

[jproffer]

The borders can be done with conditional formatting and skip the first routine altogether.

 

[Enzo_Matrix]

here are the complete version of the two subs that are causing the bugs. If possible, please help.

Sub ProductionWeld()'set fields of count as well as hose count for each category
Dim cl As Range
Dim OD As Range
Set OD = Sheets("Weld").Range("B1")
Dim TDY As Range
Set TDY = Sheets("Weld").Range("B2")
Dim TOA As Range
Set TOA = Sheets("Weld").Range("B3")
Dim LR As Long
LR = Sheets("Weld").Cells(Rows.Count, "G").End(xlUp).Row
Dim Col As String
Dim i As Long
    Col = "G"


Sheets("Weld").Activate
    
    ActiveSheet.Range("A4:I4") = Array("Department", "Sales Order Number", "Date Created", "Customer", "Size of Hose", "Quantity", "Due Date", "Days +/-", "PO")
    
    ActiveSheet.Range("A1").Select
        ActiveCell.Value = "Overdue"
    
        With OD
            .Formula = "=Sumif($G:$G,""<"" & Today(),$F:$F)"
            .Value = .Value
        End With


    ActiveSheet.Range("A2").Select
        ActiveCell.Value = "Today"
        
        With TDY
            .Formula = "=Sumif($G:$G,Today(),$F:$F)"
            .Value = .Value
        End With
    
    ActiveSheet.Range("A3").Value = "Tomorrow or After"
                   
        With TOA
            .Formula = "=Sumif($G:$G,"">"" & Today(),$F:$F)"
            .Value = .Value
        End With


' Formatting cells to make it visually appealing.
        
'Row size along with borders and justifications
    ActiveSheet.Range("A1:I70").Font.Size = 16
        Selection.HorizontalAlignment = xlCenter
        Selection.VerticalAlignment = xlCenter
        Rows("1:4").RowHeight = 30
        Rows("5:70").RowHeight = 27
        
     ActiveSheet.Range("A1:B3").Font.Size = 20
        Selection.Font.Bold = True
        Columns("A:I").AutoFit
             With Selection.Borders
                .Weight = xlMedium
                .LineStyle = xlContinuous
             End With
            
    ActiveSheet.Range("A4:I4").Font.Bold = True
        With Selection.Borders
            .Weight = xlMedium
            .LineStyle = xlContinuous
        End With
        
' Color formatting of cells based on date range
    With Sheets("Weld")
        For Each cell In Range("G5:G" & LR)
            myrow = cell.Row
            If cell <= Date Then
                Range(Cells(myrow, "A"), Cells(myrow, "G")).Interior.Color = RGB(217, 217, 217)
            End If
        Next cell
    End With
        
'Underlining cells based on date range
    With Range("A5:I100").SpecialCells(xlConstants).Borders(xlBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    
'inserting a blank line at the end of each week
For i = LR To 1 Step -1
    If Cells(i, Col).Value >= Date Then
        On Error Resume Next
            If Cells(i, Col).Value - Cells(i - 1, Col).Value > 1 Then
                On Error GoTo 0
                Cells(i, Col).EntireRow.Insert
            End If
    End If
Next i
    
End Sub

Sub FilterCopy()   
   Dim Ary As Variant
   Dim i As Long
   Dim Sht As Variant
     
   Ary = Array("Weld", "Composite", "Rubber", "Repairs")
   For Each Sht In Ary
      Sheets(Sht).UsedRange.ClearContents
   Next Sht
   With Sheets("Data")
      If .AutoFilterMode Then .AutoFilterMode = False
      For i = 0 To UBound(Ary)
         .Range("A4").AutoFilter 1, Ary(i)
         On Error Resume Next
         .UsedRange.Offset(1).SpecialCells(xlVisible).Copy Sheets(Ary(i)).Range("A" & Rows.Count).End(xlUp).Offset(4)
         On Error GoTo 0
      Next i
      .AutoFilterMode = False
   End With
    
End Sub