Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

fill blank row before insert row if there is no blank row

0

Hello

is  it  possible  fill  blank rows   based on userform before add new row before TOTAL  row and  when  filled and  there  is  no  blank rows , then  should  add  new  row  before  TOTAL row.

the  code  will  add new  row before TOTAL row   even  there  are blanks row , shouldn't  do  that .

Private Sub CommandButton1_Click()
Dim LR As Long
Dim ws As Worksheet

Set ws = Sheets("GOODS")
With ws
    ' determine last used cell in column B
    LR = .Range("B" & .Rows.Count).End(xlUp).Row
    'insert a row before end
    .Rows(LR - 1).Insert xlShiftDown, xlFormatFromLeftOrAbove
    ' copy value to inserted row
    .Rows(LR - 1).Value = .Rows(LR).Value
    ' copy UserForm values to last row
    .Range("B" & LR) = Date
    .Range("C" & LR) = TextBox1.Text
    .Range("D" & LR) = TextBox2.Text
    .Range("E" & LR) = TextBox3.Text
    .Range("F" & LR) = TextBox4.Text
End With
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""

End Sub

Answer
Discuss

Answers

0
Selected Answer

Abdo

One way to fill the four (or more) blank rows before the TOTALS row would be to loop backwards from the TOTALS row until you find a non-blank row. In the revised file attached (and code below) a new variable LstDt (last date) is used to do that- see changes in bold below:

Private Sub CommandButton1_Click()
Dim LR As Long, LstDt As Long
Dim ws As Worksheet

Set ws = Sheets("GOODS")
With ws
    ' determine last used cell in column B
    LR = .Range("B" & .Rows.Count).End(xlUp).Row

    'determine last row with date before LR
    LstDt = LR
    Do
        ' step back a row
        LstDt = LstDt - 1
    Loop Until .Range("B" & LstDt).Value <> "" Or LstDt <= 1

    If LstDt + 1 = LR Then
        'no blank rows so insert a row before end
        .Rows(LR - 1).Insert xlShiftDown, xlFormatFromLeftOrAbove
        ' copy value to inserted row
        .Rows(LR - 1).Value = .Rows(LR).Value

        Else
        ' force LR to first blank row
        LR = LstDt + 1
    End If

    ' copy UserForm values to last row
    .Range("B" & LR) = Date
    .Range("C" & LR) = TextBox1.Text
    .Range("D" & LR) = TextBox2.Text
    .Range("E" & LR) = TextBox3.Text
    .Range("F" & LR) = TextBox4.Text
End With

TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""

End Sub

You'll see that if the LstDt row is one or more before the LR, a new row isn't inserted and the Else alters LR so UserForm data gets copied to a blank row instead.

Revision 25 May 2023

Added corrected file with code including an additional criterion for the Loop Until test (to prevent a possib le infinite loop). Still relies on a pre-existing TOTALS row (other than 1).

Hope this is what you wanted.

Discuss

Discussion

excellent !
thanks  very  much , John .
Abdo M (rep: 16) May 24, '23 at 5:03 pm
Glad that helped. Thanks for selecting my Answer, Abdo.

(Please note I just corrected a couple of typos in the Answer.) 
John_Ru (rep: 6102) May 24, '23 at 5:24 pm
ok , thanks  again
Abdo M (rep: 16) May 25, '23 at 4:53 am
I realised earlier that an infinite loop is possible (if tbere is no header in column B). i can't correct my Answer file now but will later so it includes the bold addition:
Loop Until .Range("B" & LstDt).Value <> "" Or LstDt=1
John_Ru (rep: 6102) May 25, '23 at 5:30 am
File and Answer corrected, as promised above.
John_Ru (rep: 6102) May 25, '23 at 9:08 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login