none
macro to fill blank cells by above value RRS feed

  • Question

  • Hi,

    I want to create a macro so that it would fill blank cells by above its available value in column A (fruits name in below case). 

    I have the code below, modifying the code or giving me new code anything would work for me.

    Fruits Cost
    Apple $1.25
      $1.25
    Banana $2.55
      $2.55
      $2.55
    Orange $1.55
      $1.55
      $1.55
    Strawberry $4.55
      $4.55
      $4.55

    $4.55


    Sub FillBlanks()
    
    Dim rRange1 As Range, rRange2 As Range
    
    Dim iReply As Integer
    
        If Selection.Cells.Count = 1 Then
    
        MsgBox "You must select your list and include the blank cells", vbInformation, "OzGrid.com"
    
                Exit Sub
    
        ElseIf Selection.Columns.Count > 1 Then
    
            MsgBox "You must select only one column", vbInformation, "OzGrid.com"
    
                Exit Sub
    
        End If
    
        
    
        Set rRange1 = Range(Selection.Cells(1, 1), Cells(65536, Selection.Column).End(xlUp))
    
            
    
        On Error Resume Next
    
        Set rRange2 = rRange1.SpecialCells(xlCellTypeBlanks)
    
        On Error GoTo 0
    
        
    
        If rRange2 Is Nothing Then
    
            MsgBox "No blank cells Found", vbInformation, "OzGrid.com"
    
            Exit Sub
    
        End If
    
        
    
        rRange2.FormulaR1C1 = "=R[-1]C"
    
        
    
        iReply = MsgBox("Convert to Values", vbYesNo + vbQuestion, "OzGrid.com")
    
        If iReply = vbYes Then rRange1 = rRange1.Value
    
    End Sub
    
    

    Saturday, January 28, 2012 5:12 PM

Answers

  • Sub FillBlanks_R1()
      Dim rRange1 As Range, rRange2 As Range
      Dim iReply As Integer

      If Selection.Cells.Count = 1 Then
        MsgBox "You must select your list and include the blank cells", vbInformation, "OzGrid.com"
        Exit Sub
      ElseIf Selection.Columns.Count > 1 Then
        MsgBox "You must select only one column", vbInformation, "OzGrid.com"
        Exit Sub
      End If

      Set rRange1 = Range(Selection.Cells(1, 2), Cells(Rows.Count, Selection.Column + 1).End(xlUp)).Offset(, -1)
      On Error Resume Next
      Set rRange2 = rRange1.SpecialCells(xlCellTypeBlanks)
      On Error GoTo 0
     
      If rRange2 Is Nothing Then
        MsgBox "No blank cells Found", vbInformation, "OzGrid.com"
        Exit Sub
      End If
     
      rRange2.FormulaR1C1 = "=R[-1]C"
      iReply = MsgBox("Convert to Values", vbYesNo + vbQuestion, "OzGrid.com")
      If iReply = vbYes Then rRange1 = rRange1.Value
    End Sub
    '---

    Jim Cone
    Portland, Oregon USA
    http://www.mediafire.com/PrimitiveSoftware
    (Bingo Card Variety .xls workbook - in the free folder)

    • Marked as answer by sandeepTemkar Sunday, January 29, 2012 7:28 AM
    Saturday, January 28, 2012 7:29 PM
  • Re:  "at last it gives me a message as "Convert to Values", which I don't want, instead I want macro to move further for the next code without interruption of this message."

    Replace these two lines...
    iReply = MsgBox("Convert to Values", vbYesNo + vbQuestion, "OzGrid.com")
    If iReply = vbYes Then rRange1 = rRange1.Value

    With...
    rRange1.Value = rRange1.Value

    '---
    Jim Cone
    Portland, Oregon USA
    http://www.mediafire.com/PrimitiveSoftware
    (Formats & Styles xl add-in:  lists/removes unused styles & number formats) - free

    • Marked as answer by sandeepTemkar Sunday, March 11, 2012 11:22 AM
    Monday, January 30, 2012 3:43 AM

All replies

  • Sub FillBlanks_R1()
      Dim rRange1 As Range, rRange2 As Range
      Dim iReply As Integer

      If Selection.Cells.Count = 1 Then
        MsgBox "You must select your list and include the blank cells", vbInformation, "OzGrid.com"
        Exit Sub
      ElseIf Selection.Columns.Count > 1 Then
        MsgBox "You must select only one column", vbInformation, "OzGrid.com"
        Exit Sub
      End If

      Set rRange1 = Range(Selection.Cells(1, 2), Cells(Rows.Count, Selection.Column + 1).End(xlUp)).Offset(, -1)
      On Error Resume Next
      Set rRange2 = rRange1.SpecialCells(xlCellTypeBlanks)
      On Error GoTo 0
     
      If rRange2 Is Nothing Then
        MsgBox "No blank cells Found", vbInformation, "OzGrid.com"
        Exit Sub
      End If
     
      rRange2.FormulaR1C1 = "=R[-1]C"
      iReply = MsgBox("Convert to Values", vbYesNo + vbQuestion, "OzGrid.com")
      If iReply = vbYes Then rRange1 = rRange1.Value
    End Sub
    '---

    Jim Cone
    Portland, Oregon USA
    http://www.mediafire.com/PrimitiveSoftware
    (Bingo Card Variety .xls workbook - in the free folder)

    • Marked as answer by sandeepTemkar Sunday, January 29, 2012 7:28 AM
    Saturday, January 28, 2012 7:29 PM
  • Jim,

     

    It works nicely and my macro working absolutely fine.

     

    I really appreciate you help.

     

    Thank you!

    Sandeep 

    Sunday, January 29, 2012 7:29 AM
  • Just one last query if you could resolve it.

     

    at last it gives me a message as "Convert to Values", which I don't want, instead I want macro to move further for the next code without interruption of this message.

    Can you edit the above code in such a manner please?

     

    Sandeep 

    Sunday, January 29, 2012 7:51 AM
  • hi Sandeep,

    You can also accomplish the same without using VBA (in case you're interested)

    1. Select the range you want filled with the values.
    2. Hit F5 (Go To Special) - > Select Blank Cells (Assuming values are in A2:A30)
    3. With the selection, type '+A2' (without the quotes), & press Ctrl + Enter
    4. select the entire column & paste special as values

    Regards

    Neil

    Monday, January 30, 2012 12:35 AM
  • Re:  "at last it gives me a message as "Convert to Values", which I don't want, instead I want macro to move further for the next code without interruption of this message."

    Replace these two lines...
    iReply = MsgBox("Convert to Values", vbYesNo + vbQuestion, "OzGrid.com")
    If iReply = vbYes Then rRange1 = rRange1.Value

    With...
    rRange1.Value = rRange1.Value

    '---
    Jim Cone
    Portland, Oregon USA
    http://www.mediafire.com/PrimitiveSoftware
    (Formats & Styles xl add-in:  lists/removes unused styles & number formats) - free

    • Marked as answer by sandeepTemkar Sunday, March 11, 2012 11:22 AM
    Monday, January 30, 2012 3:43 AM