Adding a Data Row to Table through MACRO from another data entry sheet

[sorensjp]

Hi all,

I'm trying to Add Data to Table through a MACRO Crew_SaveNew. Each time the code is run I get the Data added but the Table does not expand one row for the new data.

I cannot figure out how to adjust the Code in Bold to find the last row and add one to the Table.

Please see the attached file.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''This MACRO Saves New Crew Member Data to sh11 (CREW_WEAPS_DB)
''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Crew_SaveNew()
Dim CrewRow As Long
Dim CrewCol As Long
With sh02
    .Range("B6").Value = True 'Set New Crew To True
If .Range("F10,H10,M10,F12,H12,K14").Value = Empty Then
    MsgBox "Please enter the Rank, Rate, Status, First, Last Name and Duty Section Assignment for the Crew Member"
    .Range("F10").Select
    Exit Sub
End If
    CrewRow = sh11.Range("D99999").End(xlUp).Row + 1   'First Avail Row
    sh11.Range("D" & CrewRow).Value = sh02.Range("B17").Value
For CrewCol = 4 To 97
    If .Range(sh11.Cells(1, CrewCol).Value).Value <> Empty Then sh11.Cells(CrewRow, CrewCol).Value = .Range(sh11.Cells(1, CrewCol).Value).Value 'update only if not blank
Next CrewCol
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''This part of the MACRO places the new Rate & Name to the Active Sheet (sh02)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
.Range("F6").Value = .Range("F10").Value 'Add in Rate
.Range("G6").Value = .Range("H12").Value & ", " & .Range("F12").Value 'Add in Last Name, First Name
    .Shapes("SaveNewGrp").Visible = msoFalse
    .Shapes("AddNewGrp").Visible = msoCTrue
    .Range("B7").Value = False 'Set Crew Load To False
    .Range("B12").Value = False 'Set New Crew Member To False
    Crew_NameListRefreash
End With

End Sub

V/r,
Jim

 

[Marc L]

This is a wild cross posting ‼​

​

According to forum rules you must add a link for each thread created on other forums …​

Site Rules - New Users - Please Read

Hi all, Welcome to the Chandoo.org Forums. Posting Rules & Etiquette The Chandoo.org Forums is a collaborative and happy place to learn and expand your Excel knowledge. The Chandoo.org Forums consist of several Sub-Forums based on the type of question/area of Excel you are interested in...

chandoo.org

 

[sorensjp]

Marc L.,

I was unaware, Thank you.

The link below is same question on Excel Forum.

This is a wild cross posting ‼​

​

According to forum rules you must add a link for each thread created on other forums …​

Site Rules - New Users - Please Read

Hi all, Welcome to the Chandoo.org Forums. Posting Rules & Etiquette The Chandoo.org Forums is a collaborative and happy place to learn and expand your Excel knowledge. The Chandoo.org Forums consist of several Sub-Forums based on the type of question/area of Excel you are interested in...

chandoo.org

https://www.excelforum.com/excel-pr...able-upon-data-entry-from-separate-sheet.html

V/r,
Jim

 

[sorensjp]

Hi,

Solved, I found thread on Mr. Excel Forum which resized the Rows after the Data was transferred to the Table.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''This MACRO Saves New Crew Member Data to sh11 (CREW_WEAPS_DB)
''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Crew_SaveNew()
Dim CrewRow As Long
Dim CrewCol As Long
Dim tblCrewWepsDB As ListObject

Set tblCrewWepsDB = sh11.ListObjects("tblCrewWepsDB")

With sh02
    .Range("B6").Value = True 'Set New Crew To True
If .Range("F10,H10,M10,F12,H12,K14").Value = Empty Then
    MsgBox "Please enter the Rank, Rate, Status, First, Last Name and Duty Section Assignment for the Crew Member"
    .Range("F10").Select
    Exit Sub
End If

    CrewRow = sh11.Range("D99999").End(xlUp).Row + 1   'First Avail Row
    sh11.Range("D" & CrewRow).Value = sh02.Range("B17").Value
For CrewCol = 4 To 97
    If .Range(sh11.Cells(1, CrewCol).Value).Value <> Empty Then sh11.Cells(CrewRow, CrewCol).Value = .Range(sh11.Cells(1, CrewCol).Value).Value 'update only if not blank
Next CrewCol

With tblCrewWepsDB.Range
tblCrewWepsDB.Resize .Resize(.CurrentRegion.Rows.Count)
End With

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''This part of the MACRO places the new Rate & Name to the Active Sheet (sh02)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
.Range("G6").Value = .Range("H12").Value & ", " & .Range("F12").Value 'Add in Last Name, First Name
    .Shapes("SaveNewGrp").Visible = msoFalse
    .Shapes("AddNewGrp").Visible = msoCTrue
    .Range("B7").Value = False 'Set Crew Load To False
    .Range("B12").Value = False 'Set New Crew Member To False
    Crew_NameListRefreash
End With
End Sub

V/r,
Jim