CODEWITHSUNDEEP
excelvba
andren
andren

Reputation: 37

Find and replace empty cell with another column

below script unable to run. it shows

runtime error 424 "object required"

Sub replace_P()
For Each rw In UsedRange.Rows
If rw.Columns("P") = "" Then
rw.Columns("P") = rw.Columns("M")
End If
Next rw
End Sub

Upvotes: 1

Views: 79

Answers (1)

VBasic2008
VBasic2008

Reputation: 54973

Replace Blanks With Values From Another Column

Option Explicit

Sub FillBlanks()
    
    ' Define constants.
    Const FirstRow As Long = 1
    Const dCol As Long = 16 ' Fill blanks in this column...
    Const sCol As Long = 13 ' ... with values from this column.
    ' Note that the previous refer to the row and columns of the used range,
    ' and they are the same as the worksheet row and columns ONLY
    ' if the used range starts in cell 'A1'.
    
    ' Reference the worksheet ('ws').
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Reference the destination column range ('dcrg').
    Dim dcrg As Range
    With ws.UsedRange
        Set dcrg = .Columns(dCol).Resize(.Rows.Count - FirstRow + 1) _
            .Offset(FirstRow - 1)
    End With
    
    ' Reference the source columns range ('scrg').
    Dim scrg As Range: Set scrg = dcrg.Offset(, sCol - dCol)
    
    ' Write the number of rows to a variable ('rCount').
    Dim rCount As Long: rCount = dcrg.Rows.Count
    
    ' Write the values from the destination and source column ranges
    ' to arrays ('dcData','scData'), to 2D one-based one-column arrays.
    
    Dim dcData() As Variant
    Dim scData() As Variant
    
    If rCount = 1 Then ' one cell
        ReDim dcData(1 To 1, 1 To 1): dcData(1, 1) = dcrg.Value
        ReDim scData(1 To 1, 1 To 1): scData(1, 1) = scrg.Value
    Else ' multiple cells
        dcData = dcrg.Value
        scData = scrg.Value
    End If
    
    ' Replace the blank values in the destination array
    ' with the corresponding values, the values in the same row,
    ' of the source array.
    
    Dim r As Long
    
    For r = 1 To rCount
        If Len(CStr(dcData(r, 1))) = 0 Then ' is blank
            dcData(r, 1) = scData(r, 1) ' write (copy)
        'Else ' is not blank; do nothing
        End If
    Next r
    
    ' Write the values from the destination array to the destination range.
    dcrg.Value = dcData
    
    ' Inform.
    MsgBox "Blanks filled.", vbInformation

End Sub

Upvotes: 2

Related Questions