Good morning guys!

Summarize the problem

So I am having trouble polishing and optimizing the code here. I am new to this but I am pretty sure this can be done better.

So I have a table in an active worksheet. What I am trying to do is this:

1. Scan Columns(A:M) of Row 6 to see if all cells are empty
2. If yes, then scan Columns (N:R) of Row 6 to see if all cells are empty
3. If 2. is false, then copy above row's Columns (A:I) in Row 6
4. Repeat 1-3 but on Row 7

This process should repeat until the rows of the table end. What I would possibly like to incorporate is ActiveSheet.ListObjects(1).Name or something similar so I am able to duplicate the sheet without having to tweak the code.

Describe what you've tried

I have tried a couple of subs trying to execute this concept. What I haven't figured out yet is how I can make this as efficient as possible and as risk free as possible. My code works (I am not entirely sure if there are any problems with it) but it's really too much.

I am posting the following code below. Pardon me if it's too basic. I am a newcomer to Excel VBA.

Show some code

Sub CopyPasteRow()
    Dim lr As Long
    Dim x As Long
    Dim y As Long
    Dim a As Long
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    a = 0
    For x = 6 To lr
        For y = 1 To 13
            If Not IsEmpty(Cells(x, y)) Then
                a = a   1
            End If
        Next y
        If a = 0 Then
            For y = 14 To 18
                If Not IsEmpty(Cells(x, y)) Then
                    a = a   1
                End If
            Next y
        Else
            a = 0
        End If
        If a <> 0 Then
                For y = 1 To 13
                    Cells(x, y).Value = Cells(x - 1, y).Value
                Next y
        End If
    a = 0
    Next x
End Sub

EDIT

This is the finalized code based on @CHill60 code. It wasn't exactly what I was aiming for but got me 99% where I wanted.

Sub CopyPasteRow()
Dim lr As Long
Dim x As Long
Dim a As Long
Dim r As Range, r2 As Range, r3 As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
For x = 6 To lr
    'check columns A to M for this row are empty
        Set r = ActiveSheet.Range("A" & CStr(x) & ":M" & CStr(x))
    
    'check columns N to R for this row are empty
        Set r2 = ActiveSheet.Range("N" & CStr(x) & ":R" & CStr(x))
    
    If WorksheetFunction.CountA(r) = 0 And WorksheetFunction.CountA(r2) <> 0 Then
        'copy the data into columns A to M
        Set r3 = ActiveSheet.Range("A" & CStr(x) & ":I" & CStr(x))
        r3.Value = r3.Offset(-1, 0).Value
    End If
Next x
End Sub

Thank you so much @CHill60.

CodePudding user response：

Instead of looking at individual cells, look at Ranges instead. Consider this snippet of code

Sub demo()
    Dim x As Long
    
    For x = 6 To 8
    
        Dim r As Range
        Set r = Sheets(1).Range("A" & CStr(x) & ":M" & CStr(x))
        Debug.Print r.Address, MyIsEmpty(r)
   
    Next x
End Sub

I have a function for checking for empty ranges

Public Function MyIsEmpty(rng As Range) As Boolean
    MyIsEmpty = WorksheetFunction.CountA(rng) = 0
End Function

I use this because the cell might "look" empty, but actually contain a formula.

Note I've explicitly said which sheet I want the Cells from - users have a habit of clicking places other than where you think they should be! :laugh:

Edit after OP comment:

E.g. your function might look like this

Sub CopyPasteRow()
    Dim lr As Long
    Dim x As Long
    Dim a As Long
    Dim r As Range, r2 As Range
    
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    
    For x = 6 To lr
        
        a = 0
    
        'check columns A to M for this row are empty
        Set r = Sheets(1).Range("A" & CStr(x) & ":M" & CStr(x))
        If Not MyIsEmpty(r) Then
            a = a   1
        End If
        
        If a = 0 Then
            'check columns N to R for this row are empty
            Set r2 = Sheets(1).Range("N" & CStr(x) & ":R" & CStr(x))
            If Not MyIsEmpty(r2) Then
                a = a   1
            End If
        Else
            a = 0
        End If
        
        If a <> 0 Then
            'copy the data into columns A to M
            'You might have to adjust the ranges here
            r.Value = r2.Value
        End If
    
    Next x

End Sub

where you have a source range and a target range - you appear to be putting the values in the previous row so my value of r is probably wrong in this example - you could use r.Offset(-1,0).Value = r2.Value I'm also not sure what you are trying to do with the variable a If that is meant to be a "flag" then consider using a Boolean instead - it only has the values True or False