Fill blank cells in multiple columns on specific sheets

I have the following columns
enter image description here

Score   Name    Last Name
5460    Name1   Lastname1
2620        
340     
470     
3445    Name2   Lastname2
1290        
1170        
7460    Name3   Lastname3
3520        
360     
1500        
5048    Name4   Lastname4
830     
490     
1883        
620     
1208        
185     
426     
653     

      


I want to fill blank cells in columns B and C until the last row with column A (which is row 21 in this example).
Result
enter image description here

Score   Name    Last Name
5460    Name1   Lastname1
2620    Name1   Lastname1
340     Name1   Lastname1
470     Name1   Lastname1
3445    Name2   Lastname2
1290    Name2   Lastname2
1170    Name2   Lastname2
7460    Name3   Lastname3
3520    Name3   Lastname3
360     Name3   Lastname3
1500    Name3   Lastname3
5048    Name4   Lastname4
830     Name4   Lastname4
490     Name4   Lastname4
1883    Name4   Lastname4
620     Name4   Lastname4
1208    Name4   Lastname4
185     Name4   Lastname4
426     Name4   Lastname4
653     Name4   Lastname4

      


I am currently trying to adapt this vba code:

Sub FillColBlanksSpecial()

Dim wks As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim LastRow As Long
Dim col As Long
Dim lRows As Long
Dim lLimit As Long

Dim lCount As Long
On Error Resume Next

lRows = 2
lLimit = 1000

Set wks = ActiveSheet
With wks

   col = .Range("b1,c1").Column

   Set rng = .UsedRange  'try to reset the lastcell
   LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
   Set rng = Nothing

    lCount = .Columns(col).SpecialCells(xlCellTypeBlanks).Areas(1).Cells.Count

    If lCount = 0 Then
        MsgBox "No blanks found in selected column"
        Exit Sub
    ElseIf lCount = .Columns(col).Cells.Count Then
        Do While lRows < LastRow
            Set rng = .Range(.Cells(lRows, col), .Cells(lRows + lLimit, col)) _
                           .Cells.SpecialCells(xlCellTypeBlanks)
            rng.FormulaR1C1 = "=R[-1]C"
            lRows = lRows + lLimit
        Loop
    Else
        Set rng = .Range(.Cells(2, col), .Cells(LastRow, col)) _
                       .Cells.SpecialCells(xlCellTypeBlanks)
        rng.FormulaR1C1 = "=R[-1]C"
    End If
End With

End Sub

      


Question1: This code only works on column Bed and . How to run in Column B and C As you can see in the code, I tried col = .Range("b1,c1").Column

it but to no avail.

Question2: How do I run this on sheets whose name ends in -A and -B in only one book?

In the same book, I have hundrends of sheets, but I only want to run on those that end in the above suffixes. Thank.

+3


source to share


1 answer


You can use the same variable you used for the active sheet in the loop to cycle through the collection of sheets, checking the sheet name to see if it needs processing.

Sub FillColBlanksSpecial()
    Dim wks As Worksheet

    For Each wks In Worksheets
        If Right(wks.Name, 2) = "-A" Or Right(wks.Name, 2) = "-B" Then
            With wks
                With .Cells(1, 1).CurrentRegion
                    With .Columns("B:C")
                        If CBool(Application.CountBlank(.Cells)) Then
                            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=r[-1]c"
                        End If
                    End With
                    'un comment the next line if you want the formulas to revert to values only
                    '.Cells = .Cells.Value
                End With
            End With
        End If
    Next wks

End Sub

      



I added a line to revert duplicate formulas to their base values, but left it in the comments. Uncomment the line if you only prefer values.

+2


source







All Articles