fill blank rows or insert blank rows before lastrow by userform

[Abdo]

Hi guys,
I want copy data from all of textboxes on userform to sheet
column A should populate date , column B=textbox1,column C =textbox2, column D=textbox3
column E should calculate as I put the formulas( formula in second row is not after until before TOTAL row ).
TOTAL row should sum columns C,D
textbox2,3 will add numeric values
should copy and fill in blank rows , if there is no blank rows then will add new blank row before total row with the same formatting .
I don't need showing any formula.

here is my data on sheet & code

fill (2).xlsm
	A	B	C	D	E
1	DATE	BRAND	IMPORT	EXPORT	NET
2					0.00
3					0.00
4					0.00
5	TOTAL		0.00	0.00	0.00
ATSS

Cell Formulas
Range	Formula
E2,E5	E2	=C2-D2
E3:E4	E3	=E2+C3-D3
C5:D5	C5	=SUM(C2:C4)

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

Set ws = Sheets("ATSS")
With ws
LR = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A" & LR + 1) = Date
.Range("B" & LR + 1) = TextBox1.Text
.Range("C" & LR + 1) = TextBox2.Text
.Range("D" & LR + 1) = TextBox3.Text

End With
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""


End Sub

also posted here
fill blank rows or insert blank rows before lastrow by userform
thanks

 

[DanteAmor]

Your sheet should retain at least the formulas in cells E2 and E3.
From then on the macro can insert the rows and continue creating the formulas for the total row and column E.

Try:

Private Sub CommandButton1_Click()
  Dim i As Long
  Dim ws As Worksheet
  Dim f As Range
  
  Application.ScreenUpdating = False
  Set ws = Sheets("ATSS")
  i = 2
  Do While Range("A" & i).Value <> ""
    i = i + 1
    If ws.Range("A" & i).Value = "TOTAL" Then
      ws.Range("A" & i & ":E" & i).Insert Shift:=xlDown
    End If
  Loop
  
  ws.Range("A" & i) = Date
  ws.Range("B" & i) = TextBox1.Text
  ws.Range("C" & i) = TextBox2.Text
  ws.Range("D" & i) = TextBox3.Text
  If i - 1 > 2 Then ws.Range("E" & i - 1).Copy ws.Range("E" & i)
  Set f = ws.Range("A:A").Find("TOTAL", , xlValues, xlWhole, , , False)
  With ws.Range("C" & f.Row & ":D" & f.Row)
    .Formula = "=SUM(C2:C" & f.Row - 1 & ")"
  End With
  
  TextBox1.Value = ""
  TextBox2.Value = ""
  TextBox3.Value = ""
  Application.ScreenUpdating = True
End Sub

 

[Abdo]

Hi Dante,

Your sheet should retain at least the formulas in cells E2 and E3.

if there is way to add formula by code as in value . I don't want showing formulas
thanks for your time .

 

[DanteAmor]

I don't need showing any formula.

Then try:

Private Sub CommandButton1_Click()
  Dim i As Long
  Dim ws As Worksheet
  Dim f As Range
  
  Application.ScreenUpdating = False
  Set ws = Sheets("ATSS")
  i = 2
  Do While Range("A" & i).Value <> ""
    i = i + 1
    If ws.Range("A" & i).Value = "TOTAL" Then
      ws.Range("A" & i & ":E" & i).Insert Shift:=xlDown
    End If
  Loop
  
  ws.Range("A" & i) = Date
  ws.Range("B" & i) = TextBox1.Text
  ws.Range("C" & i) = TextBox2.Text
  ws.Range("D" & i) = TextBox3.Text
  If i = 2 Then
    ws.Range("E2").Value = ws.Range("C2").Value - ws.Range("D2").Value
  Else
    ws.Range("E" & i).Value = ws.Range("E" & i - 1).Value + ws.Range("C" & i).Value - ws.Range("D" & i).Value
  End If
  
  Set f = ws.Range("A:A").Find("TOTAL", , xlValues, xlWhole, , , False)
  With ws.Range("C" & f.Row & ":D" & f.Row)
    .Formula = "=SUM(C2:C" & f.Row - 1 & ")"
    .Value = .Value
  End With
  ws.Range("E" & f.Row).Value = ws.Range("C" & f.Row).Value - ws.Range("D" & f.Row).Value
  
  TextBox1.Value = ""
  TextBox2.Value = ""
  TextBox3.Value = ""
  Application.ScreenUpdating = True
End Sub

 

[Abdo]

it's awesome !
many thanks for your assistance