do i really have to manually extend the sheet every data entry

dgwan

New Member
Joined
May 4, 2022
Messages
11
Office Version
  1. 2019
Platform
  1. Windows
Code:
Private Sub CommandButton1_Click()
Me.AreaBox = ""
Me.MonthBox = ""
Me.DayBox = ""
Me.YearBox = ""
Me.TextBox1 = ""
Me.TextBox2 = ""
Me.TextBox3 = ""
Me.TextBox4 = ""
Me.TextBox5 = ""
Me.TextBox6 = ""
End Sub

Private Sub CommandButton2_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("DATA")
Dim last_Row As Long
last_Row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
'Validations-------------------------------------------
If Me.AreaBox.Value = "" Then
MsgBox "Please select the Area.", vbCritical
Exit Sub
End If
'------------------------------------------------------
If Me.MonthBox.Value = "" Then
MsgBox "Please select the Month.", vbCritical
Exit Sub
End If
'------------------------------------------------------
If Me.DayBox.Value = "" Then
MsgBox "Please select the Day.", vbCritical
Exit Sub
End If
'------------------------------------------------------
If Me.YearBox.Value = "" Then
MsgBox "Please select the Year.", vbCritical
Exit Sub
End If
'------------------------------------------------------
sh.Range("A" & last_Row + 1).Value = "=ROW() -1"
sh.Range("B" & last_Row + 1).Value = Me.MonthBox.Value
sh.Range("C" & last_Row + 1).Value = Me.DayBox.Value
sh.Range("D" & last_Row + 1).Value = Me.YearBox.Value
sh.Range("E" & last_Row + 1).Value = Me.AreaBox.Value
sh.Range("F" & last_Row + 1).Value = Me.TextBox1.Value
sh.Range("G" & last_Row + 1).Value = Me.TextBox2.Value
sh.Range("H" & last_Row + 1).Value = Me.TextBox3.Value
sh.Range("I" & last_Row + 1).Value = Me.TextBox4.Value
sh.Range("J" & last_Row + 1).Value = Me.TextBox5.Value
'------------------------------------------------------
Me.MonthBox.Value = ""
Me.DayBox.Value = ""
Me.YearBox.Value = ""
Me.AreaBox.Value = ""
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
'------------------------------------------------------
Call Refresh_Data

End Sub

Private Sub CommandButton3_Click()

If Me.TextBox6.Value = "" Then
MsgBox "Select the record to update."
Exit Sub
End If

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("DATA")
Dim Selected_Row As Long
Selected_Row = Application.WorksheetFunction.Match(CLng(Me.TextBox6.Value), sh.Range("A:A"), 0)
'Validations-------------------------------------------
If Me.AreaBox.Value = "" Then
MsgBox "Please select the Area.", vbCritical
Exit Sub
End If
'------------------------------------------------------
If Me.MonthBox.Value = "" Then
MsgBox "Please select the Month.", vbCritical
Exit Sub
End If
'------------------------------------------------------
If Me.DayBox.Value = "" Then
MsgBox "Please select the Day.", vbCritical
Exit Sub
End If
'------------------------------------------------------
If Me.YearBox.Value = "" Then
MsgBox "Please select the Year.", vbCritical
Exit Sub
End If
'------------------------------------------------------
sh.Range("B" & Selected_Row).Value = Me.MonthBox.Value
sh.Range("C" & Selected_Row).Value = Me.DayBox.Value
sh.Range("D" & Selected_Row).Value = Me.YearBox.Value
sh.Range("E" & Selected_Row).Value = Me.AreaBox.Value
sh.Range("F" & Selected_Row).Value = Me.TextBox1.Value
sh.Range("G" & Selected_Row).Value = Me.TextBox2.Value
sh.Range("H" & Selected_Row).Value = Me.TextBox3.Value
sh.Range("I" & Selected_Row).Value = Me.TextBox4.Value
sh.Range("J" & Selected_Row).Value = Me.TextBox5.Value
'------------------------------------------------------
Me.MonthBox.Value = ""
Me.DayBox.Value = ""
Me.YearBox.Value = ""
Me.AreaBox.Value = ""
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""
'------------------------------------------------------
Call Refresh_Data

End Sub

Private Sub CommandButton4_Click()
If Me.TextBox6.Value = "" Then
MsgBox "Select the record to delete."
Exit Sub
End If

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("DATA")
Dim Selected_Row As Long
Selected_Row = Application.WorksheetFunction.Match(CLng(Me.TextBox6.Value), sh.Range("A:A"), 0)
'------------------------------------------------------
sh.Range("A" & Selected_Row).EntireRow.Delete
'------------------------------------------------------
Me.MonthBox.Value = ""
Me.DayBox.Value = ""
Me.YearBox.Value = ""
Me.AreaBox.Value = ""
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""

Call Refresh_Data

End Sub

Private Sub CommandButton5_Click()
ThisWorkbook.Save
MsgBox "Data Saved!"
End Sub


Private Sub Frame1_Click()

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.TextBox6.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)
Me.MonthBox.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
Me.DayBox.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 2)
Me.YearBox.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 3)
Me.AreaBox.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 4)
Me.TextBox1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 5)
Me.TextBox2.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 6)
Me.TextBox3.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 7)
Me.TextBox4.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 8)
Me.TextBox5.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 9)

End Sub

Private Sub TextBox7_Change()

End Sub

Private Sub MonthBox_Change()

End Sub

Private Sub UserForm_Activate()
With Me.AreaBox
        .Clear
        .AddItem "7th WEST"
        .AddItem "6th WEST"
        .AddItem "6th ICU"
        .AddItem "5th WEST"
        .AddItem "5th EAST"
        .AddItem "4th ICU"
        .AddItem "3rd WEST"
        .AddItem "3rd EAST"
End With
With Me.MonthBox
        .Clear
        .AddItem "January"
        .AddItem "February"
        .AddItem "March"
        .AddItem "April"
        .AddItem "May"
        .AddItem "June"
        .AddItem "July"
        .AddItem "August"
        .AddItem "September"
        .AddItem "October"
        .AddItem "November"
        .AddItem "December"
End With
With Me.DayBox
        .Clear
        .AddItem "1"
        .AddItem "2"
        .AddItem "3"
        .AddItem "4"
        .AddItem "5"
        .AddItem "6"
        .AddItem "7"
        .AddItem "8"
        .AddItem "9"
        .AddItem "10"
        .AddItem "11"
        .AddItem "12"
        .AddItem "13"
        .AddItem "14"
        .AddItem "15"
        .AddItem "16"
        .AddItem "17"
        .AddItem "18"
        .AddItem "19"
        .AddItem "20"
        .AddItem "21"
        .AddItem "22"
        .AddItem "23"
        .AddItem "24"
        .AddItem "25"
        .AddItem "26"
        .AddItem "27"
        .AddItem "28"
        .AddItem "29"
        .AddItem "30"
        .AddItem "31"
End With
With Me.YearBox
        .Clear
        .AddItem "2022"
        .AddItem "2021"
        .AddItem "2020"
        .AddItem "2019"
        .AddItem "2018"
        .AddItem "2017"
        .AddItem "2016"
        .AddItem "2015"
End With

Call Refresh_Data
End Sub

Sub Refresh_Data()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("DATA")
Dim last_Row As Long
last_Row = Application.WorksheetFunction.CountA(sh.Range("A:A"))

With Me.ListBox1
        .ColumnHeads = True
        .ColumnCount = 10
        .ColumnWidths = "40, 50, 30, 30, 55, 60, 65, 65, 40, 40"
        .TextAlign = fmTextAlignCenter
        
        If last_Row = 1 Then
        .RowSource = "DATA!A2:J2"
        Else
        .RowSource = "DATA!A2:J" & last_Row
        End If
        
End With
End Sub
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
do i really have to manually extend the sheet every data entry
Yes, unless you spend some of your time to explain what you mean (without expecting we guess it by decoding your code) ;)
 
Upvote 0
I thought it was something basic that i just couldnt find a way so i didnt elaborate more my bad, but yeah im using an userform and every entry, my Data table doesnt automatically extend for every entry. Is there a way to make it automatic?
 
Upvote 0
Do you mean the data is in a structured table?
If so what is the name of the table?
 
Upvote 0
I didnt know the term but i think it is, it's named NSOTable
 
Upvote 0
Try replacing, within your Sub Refresh_Data, the line last_Row = Application.WorksheetFunction.CountA(sh.Range("A:A")) by
VBA Code:
Last_Row = Evaluate("MAX(IF('DATA'!A2:J1000<>"""",ROW('DATA'!A2:A1000),""""))")
This in case that column A is not always filled with datas

bye
 
Upvote 0
Ok, how about
VBA Code:
Private Sub CommandButton2_Click()
Dim nxtrw As WorkSheet
Set sh = ThisWorkbook.Sheets("Data")
Dim nxtrw As ListRow
'Validations-------------------------------------------
If Me.AreaBox.Value = "" Then
MsgBox "Please select the Area.", vbCritical
Exit Sub
End If
'------------------------------------------------------
If Me.MonthBox.Value = "" Then
MsgBox "Please select the Month.", vbCritical
Exit Sub
End If
'------------------------------------------------------
If Me.DayBox.Value = "" Then
MsgBox "Please select the Day.", vbCritical
Exit Sub
End If
'------------------------------------------------------
If Me.YearBox.Value = "" Then
MsgBox "Please select the Year.", vbCritical
Exit Sub
End If
'------------------------------------------------------
Set nxtrw = sh.ListObjects("NSOTable").ListRows.Add
nxtrw.Range(1).Value = "=ROW() -1"
nxtrw.Range(2).Value = Me.MonthBox.Value
nxtrw.Range(3).Value = Me.DayBox.Value
nxtrw.Range(4).Value = Me.YearBox.Value
nxtrw.Range(5).Value = Me.AreaBox.Value
nxtrw.Range(6).Value = Me.TextBox1.Value
nxtrw.Range(7).Value = Me.TextBox2.Value
nxtrw.Range(8).Value = Me.TextBox3.Value
nxtrw.Range(9).Value = Me.TextBox4.Value
nxtrw.Range(10).Value = Me.TextBox5.Value
'------------------------------------------------------
Me.MonthBox.Value = ""
Me.DayBox.Value = ""
Me.YearBox.Value = ""
Me.AreaBox.Value = ""
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
'------------------------------------------------------
Call Refresh_Data

End Sub
 
Upvote 0
Don't miss Fluff's suggestion, above

Following what I suggested in message #6, I suggest you add also the following initializing code to your form
VBA Code:
Private Sub UserForm_Initialize()
last_Row = Evaluate("MAX(IF('DATA'!A2:J1000<>"""",ROW('DATA'!A2:A1000),""""))")
Me.ListBox1.RowSource = "DATA!A2:J" & last_Row
End Sub
 
Upvote 0
From what the OP has said I don't think it's a problem with finding the last row, but more the data isn't going into the table.
 
Upvote 0
Try replacing, within your Sub Refresh_Data, the line last_Row = Application.WorksheetFunction.CountA(sh.Range("A:A")) by
VBA Code:
Last_Row = Evaluate("MAX(IF('DATA'!A2:J1000<>"""",ROW('DATA'!A2:A1000),""""))")
This in case that column A is not always filled with datas

bye
I tried it and its still the same, i unchecked the total row but every entry its coming back. then after i entered the second data its not joining the table so thats what i meant by manually extending
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,988
Members
448,538
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top