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

D

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

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Sort by date Sort by votes
do i really have to manually extend the sheet every data entry
Click to expand...
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
Anthony47 said:
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
Click to expand...
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
You must log in or register to reply here.

Similar threads

G
  • Question Question
Run-Time Error 381
Replies
1
Views
55
Micron
M
SemperFi
  • Solved
VBA Form TextBox needs formatting
Replies
1
Views
543
SemperFi
SemperFi
J
  • Question Question
Userform inconsistent responses
Replies
1
Views
194
Candyman8019
C
K
  • Question Question
Help Needed
2
Replies
13
Views
319
kwavic
K
G
  • Question Question
Cannot create a new time-in entry
Replies
2
Views
183
genesix
G

Forum statistics

Threads
1,223,903
Messages
6,175,287
Members
452,631
Latest member
a_potato

Share this page

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