New row added to table does not bring down formulae and conditional formatting from the line above.

Robert_Conklin

Board Regular
Joined
Jun 19, 2017
Messages
120
I recently got my VBA code working to create a new row in my tables without overwriting data in the line below. The issue I am having is there are some cells in my workbook that have formulae and some have conditional formatting that the new table row needs to inherit from the line above when it is created. These cells that contain these formulae and cond. formatting pull data from other sheets in the workbook. Below is my code, any insight would be greatly appreciated.

Code:
Option ExplicitDim iRow As Long, i As Long, j As Long
Dim ctrl As Control
Dim collist As Collection
Dim tbx As OLEObject
Dim Row As ListRow
Private Sub cb01_Click()
Dim oNewRow As ListRow


With Sheets("PGS Score Card").ListObjects("PGSSC_tbl")
     Set oNewRow = .ListRows.Add(Alwaysinsert:=True)
         oNewRow.Range.Cells(1, 2).Resize(, 17).Value = Array(tbx01.Value, , tbx21.Value, tbx02.Value, tbx18.Value)
End With


With Sheets("PGSSavingsTimeline(Projections)").ListObjects("PGSSTP_tbl")
     Set oNewRow = .ListRows.Add(Alwaysinsert:=True)
         oNewRow.Range.Cells(1, 1).Resize(, 22).Value = Array(cbx13.Value, tbx01.Value, cbx02.Value, tbx21.Value, tbx22.Value, tbx03.Value, cbx04.Value, _
         cbx05.Value, cbx06.Value, cbx07.Value, tbx04.Value, cbx08.Value, tbx26.Value, tbx05.Value, tbx06.Value, tbx07.Value, cbx09.Value, tbx09.Value, _
         tbx08.Value, tbx27.Value, tbx23.Value, tbx24.Value)
End With
With Sheets("PG&S Savings Timeline (Roll-up)").ListObjects("PGSSTRu_tbl")
     Set oNewRow = .ListRows.Add(Alwaysinsert:=True)
         oNewRow.Range.Cells(1, 2).Resize(, 22).Value = Array(, tbx01.Value, , , , , , cbx10.Value, cbx12.Value, tbx10.Value, cbx14.Value, tbx11.Value, _
         cbx11.Value, tbx12.Value, , , , , , , , , , , , tbx25.Value, tbx19.Value, , tbx15.Value, , , , tbx20.Value, tbx17.Value, tbx14.Value)
End With
  For Each ctrl In Controls
        If TypeName(ctrl) = "TextBox" Or TypeName(ctrl) = "ComboBox" Then ctrl.Value = ""
Next ctrl
    LB_01.ListIndex = -1
    Call UserForm_Initialize
End Sub
Private Sub cb03_Click()
'Clear all fields
    For Each ctrl In Controls
        If TypeName(ctrl) = "TextBox" Or TypeName(ctrl) = "ComboBox" Then
            ctrl.Value = ""
            ctrl.BackColor = RGB(255, 255, 255)
        End If
    Next ctrl
        LB_01.ListIndex = -1
        Call UserForm_Initialize
End Sub
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
829
Office Version
2010
Platform
Windows
Are you sure the formulae aren't being copied down and then overwritten ?

Check by putting a breakpoint on the lines where you resize the oNewRow cells
and when the code stops at the breakpoints go to the sheet and check if the formulae are existing prior to writing to the table.
 

Robert_Conklin

Board Regular
Joined
Jun 19, 2017
Messages
120
I applied the breakpoints as suggested (awesome trick by the way) and the formulae were indeed copied down from the line above with the exception of one cell.
 

Robert_Conklin

Board Regular
Joined
Jun 19, 2017
Messages
120
On a side note, from the other question you helped with. Is my code, as it stands now, only working with the tables and not both the sheet and tables?
 

Robert_Conklin

Board Regular
Joined
Jun 19, 2017
Messages
120
To be more specific, the formulae are overwritten on the PGS Score Card, and the PGS Savings Timeline (Roll-Up) sheets. The PGSSavingsTimeline(Projections) is ok. The difference in these sheets are the spacers (,) when writing to each cell. The spacers indicate cells that contain formulae that will auto-fill based on the entries of other cells.
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
829
Office Version
2010
Platform
Windows
The code is applying to the tables.
I personally wouldn't write to the tables using that array method, I'd write it out as the specific cell = the specific control.
I think you are of the impression that those commas in the array cause the write to skip those particular locations when in fact it is what's between the commas that is written.

try doing them this way
Code:
With Sheets("PGS Score Card").ListObjects("PGSSC_tbl")
     Set oNewRow = .ListRows.Add(Alwaysinsert:=True)
         With oNewRow.Range
            .Cells(1, 2) = Me.tbx01
            .Cells(1, 4) = Me.tbx21
            .Cells(1, 5) = Me.tbx02
            .Cells(1, 6) = Me.tbx18
        End With
End With
 

Robert_Conklin

Board Regular
Joined
Jun 19, 2017
Messages
120
You are right, that is exactly what I thought he (,) did. I changed my code and it is working!! The only issue I am having with this particular change is the conditional formatting in some cells. The new line will not bring down the conditional formatting from the line above. Do I need to correct this is the portion of code in RED?

Code:
Option ExplicitDim iRow As Long, i As Long, j As Long
Dim ctrl As Control
Dim collist As Collection
Dim tbx As OLEObject
Dim Row As ListRow
Private Sub cb01_Click()
Dim oNewRow As ListRow


With Sheets("PGS Score Card").ListObjects("PGSSC_tbl")
     Set oNewRow = .ListRows.Add(Alwaysinsert:=True)
         With oNewRow.Range
            .Cells(1, 2) = Me.tbx01
            .Cells(1, 4) = Me.tbx21
            .Cells(1, 5) = Me.tbx02
            .Cells(1, 6) = Me.tbx18
End With


With Sheets("PGSSavingsTimeline(Projections)").ListObjects("PGSSTP_tbl")
     Set oNewRow = .ListRows.Add(Alwaysinsert:=True)
         With oNewRow.Range
            .Cells(1, 1) = Me.cbx13
            .Cells(1, 2) = Me.tbx01
            .Cells(1, 3) = Me.cbx02
            .Cells(1, 4) = Me.tbx21
            .Cells(1, 5) = Me.tbx22
            .Cells(1, 6) = Me.tbx03
            .Cells(1, 7) = Me.cbx04
            .Cells(1, 8) = Me.cbx05
            .Cells(1, 9) = Me.cbx06
            .Cells(1, 10) = Me.cbx07
            .Cells(1, 11) = Me.tbx04
            .Cells(1, 12) = Me.cbx08
            .Cells(1, 13) = Me.tbx26
            .Cells(1, 14) = Me.tbx05
            .Cells(1, 15) = Me.tbx06
            .Cells(1, 16) = Me.tbx07
            .Cells(1, 17) = Me.cbx09
            .Cells(1, 18) = Me.tbx09
            .Cells(1, 19) = Me.tbx08
            .Cells(1, 20) = Me.tbx27
            .Cells(1, 21) = Me.tbx23
            .Cells(1, 22) = Me.tbx24
End With


With Sheets("PG&S Savings Timeline (Roll-up)").ListObjects("PGSSTRu_tbl")
     Set oNewRow = .ListRows.Add(Alwaysinsert:=True)
         With oNewRow.Range
            .Cells(1, 2) = Me.tbx01
            .Cells(1, 8) = Me.cbx10
            .Cells(1, 9) = Me.cbx12
            .Cells(1, 10) = Me.tbx10
            .Cells(1, 11) = Me.cbx14
            .Cells(1, 12) = Me.tbx11
            .Cells(1, 13) = Me.cbx11
            .Cells(1, 14) = Me.tbx12
            .Cells(1, 26) = Me.tbx25
            .Cells(1, 27) = Me.tbx19
            .Cells(1, 29) = Me.tbx15
            .Cells(1, 33) = Me.tbx20
            .Cells(1, 34) = Me.tbx17
            .Cells(1, 35) = Me.tbx14
End With


  For Each ctrl In Controls
        If TypeName(ctrl) = "TextBox" Or TypeName(ctrl) = "ComboBox" Then ctrl.Value = ""
Next ctrl
    LB_01.ListIndex = -1
    Call UserForm_Initialize
       End With
    End With
End With
End Sub
Private Sub cb03_Click()
'Clear all fields
    For Each ctrl In Controls
        If TypeName(ctrl) = "TextBox" Or TypeName(ctrl) = "ComboBox" Then
            ctrl.Value = ""
            ctrl.BackColor = RGB(255, 255, 255)
        End If
    Next ctrl
        LB_01.ListIndex = -1
        Call UserForm_Initialize
End Sub
Private Sub cb04_Click()
Unload Me
End Sub
Private Sub cbx07_Change()
If cbx07.Value = "" Then tbx04.Value = ""
If cbx07.Value = "High" Then tbx04.Value = "H"
If cbx07.Value = "Medium" Then tbx04.Value = "M"
If cbx07.Value = "Low" Then tbx04.Value = "L"
End Sub


Private Sub Frame1_Click()


End Sub


Private Sub Frame2_Click()


End Sub


Private Sub Frame3_Click()


End Sub
Private Sub cb02_PRINT_Click()
Application.ScreenUpdating = False
If LB_01.ListIndex = -1 Then
        MsgBox "First choose a item in the list!", vbCritical, "Attention!"
        LB_01.SetFocus
        Exit Sub
    End If
    With Sheets("Print Project Data")
        Worksheets("Print Project Data").Visible = True
        .OLEObjects("textbox1").Object.Text = tbx01
        .OLEObjects("textbox2").Object.Text = cbx06
        .OLEObjects("textbox3").Object.Text = tbx12
        .OLEObjects("textbox4").Object.Text = cbx08
        .OLEObjects("textbox5").Object.Text = cbx07
        .OLEObjects("textbox6").Object.Text = tbx04
        .OLEObjects("textbox7").Object.Text = cbx02
        .OLEObjects("textbox8").Object.Text = tbx21
        .OLEObjects("textbox9").Object.Text = tbx22
        .OLEObjects("textbox10").Object.Text = tbx03
        .OLEObjects("textbox11").Object.Text = cbx13
        .OLEObjects("textbox12").Object.Text = cbx04
        .OLEObjects("textbox13").Object.Text = cbx05
        .OLEObjects("textbox14").Object.Text = tbx05
        .OLEObjects("textbox15").Object.Text = tbx07
        .OLEObjects("textbox16").Object.Text = cbx09
        .OLEObjects("textbox17").Object.Text = tbx06
        .OLEObjects("textbox18").Object.Text = tbx02
        .OLEObjects("textbox19").Object.Text = tbx13
        .OLEObjects("textbox20").Object.Text = tbx09
        .OLEObjects("textbox21").Object.Text = tbx14
        .OLEObjects("textbox22").Object.Text = tbx19
        .OLEObjects("textbox23").Object.Text = tbx08
        .OLEObjects("textbox24").Object.Text = tbx23
        .OLEObjects("textbox25").Object.Text = tbx15
        .OLEObjects("textbox26").Object.Text = tbx20
        .OLEObjects("textbox27").Object.Text = tbx24
        .OLEObjects("textbox28").Object.Text = tbx17
        .OLEObjects("textbox29").Object.Text = tbx18
        .OLEObjects("textbox30").Object.Text = cbx10
        .OLEObjects("textbox31").Object.Text = cbx11
        .OLEObjects("textbox32").Object.Text = cbx12
        .OLEObjects("textbox33").Object.Text = tbx10
        .OLEObjects("textbox34").Object.Text = cbx13
        .OLEObjects("textbox35").Object.Text = tbx11
        .PrintOut
        End With
        Application.ScreenUpdating = True
         Worksheets("Print Project Data").Visible = xlVeryHidden
         For Each ctrl In Controls
        If TypeName(ctrl) = "TextBox" Or TypeName(ctrl) = "ComboBox" Then ctrl.Value = ""
    Next ctrl
    For Each tbx In Sheets("Print Project Data").OLEObjects
        If TypeName(tbx.Object) = "TextBox" Then
            tbx.Object.Text = ""
        End If
    Next
    Call UserForm_Initialize
End Sub


Private Sub LB_01_Click()
'List box column order
        tbx01.Value = LB_01.Column(0)
        cbx06.Value = LB_01.Column(1)
        tbx12.Value = LB_01.Column(2)
        cbx08.Value = LB_01.Column(3)
        cbx07.Value = LB_01.Column(4)
        tbx04.Text = LB_01.Column(5)
        cbx02.Value = LB_01.Column(6)
        tbx21.Value = LB_01.Column(7)
        tbx22.Value = LB_01.Column(8)
        tbx03.Value = LB_01.Column(9)
        cbx13.Value = LB_01.Column(10)
        cbx04.Value = LB_01.Column(11)
        cbx05.Value = LB_01.Column(12)
        tbx05.Value = LB_01.Column(13)
        tbx07.Value = LB_01.Column(14)
        cbx09.Value = LB_01.Column(15)
        tbx06.Value = LB_01.Column(16)
        tbx02.Value = LB_01.Column(17)
        tbx13.Value = LB_01.Column(18)
        tbx09.Value = LB_01.Column(19)
        tbx14.Value = LB_01.Column(20)
        tbx19.Value = LB_01.Column(21)
        tbx08.Value = LB_01.Column(22)
        tbx23.Value = LB_01.Column(23)
        tbx15.Value = LB_01.Column(24)
        tbx24.Value = LB_01.Column(25)
        tbx16.Value = LB_01.Column(26)
        tbx17.Value = LB_01.Column(27)
        tbx18.Value = LB_01.Column(28)
        cbx10.Value = LB_01.Column(29)
        cbx11.Value = LB_01.Column(30)
        cbx12.Value = LB_01.Column(31)
        tbx10.Value = LB_01.Column(32)
        cbx13.Value = LB_01.Column(33)
        tbx11.Value = LB_01.Column(34)
    End Sub
[COLOR=#ff0000]Private Sub UserForm_Initialize()[/COLOR]
[COLOR=#ff0000]Set collist = New Collection[/COLOR]
[COLOR=#ff0000]With Worksheets("DROP DOWN LISTS")[/COLOR]
[COLOR=#ff0000]    For i = 2 To 329[/COLOR]
[COLOR=#ff0000]    On Error Resume Next[/COLOR]
[COLOR=#ff0000]        collist.Add .Cells(i, 2).Value, CStr(.Cells(i, 2))[/COLOR]
[COLOR=#ff0000]    Next i[/COLOR]
[COLOR=#ff0000]        For j = 1 To collist.Count[/COLOR]
[COLOR=#ff0000]        Next j[/COLOR]
[COLOR=#ff0000]End With[/COLOR]
[COLOR=#ff0000]cbx02.List = [Category].Value[/COLOR]
[COLOR=#ff0000]cbx04.List = [savingstype].Value[/COLOR]
[COLOR=#ff0000]cbx05.List = [onetimesavings].Value[/COLOR]
[COLOR=#ff0000]cbx06.List = [wave].Value[/COLOR]
[COLOR=#ff0000]cbx07.List = [confidencelevel].Value[/COLOR]
[COLOR=#ff0000]cbx08.List = [projectstatus].Value[/COLOR]
[COLOR=#ff0000]cbx09.List = [savingsrange].Value[/COLOR]
[COLOR=#ff0000]cbx10.List = [pltrackingreq].Value[/COLOR]
[COLOR=#ff0000]cbx11.List = [trackerinplace].Value[/COLOR]
[COLOR=#ff0000]cbx12.List = [spotcheckreq].Value[/COLOR]
[COLOR=#ff0000]tbx09.Value = Format(Date, "dd-mmm-yy")[/COLOR]
[COLOR=#ff0000]cbx13.List = [initiativetype].Value[/COLOR]
[COLOR=#ff0000]cbx14.List = [savingsflow].Value[/COLOR]
[COLOR=#ff0000]tbx13.Value = Format(Date, "dd-mmm-yy")[/COLOR]
[COLOR=#ff0000]tbx14.Value = Format(Date, "dd-mmm-yy")[/COLOR]
[COLOR=#ff0000]tbx15.Value = Format(Date, "dd-mmm-yy")[/COLOR]
[COLOR=#ff0000]tbx20.Value = Format(Date, "dd-mmm-yy")[/COLOR]
[COLOR=#ff0000]tbx23.Value = Format(Date, "dd-mmm-yy")[/COLOR]
[COLOR=#ff0000]tbx24.Value = Format(Date, "dd-mmm-yy")[/COLOR]
[COLOR=#ff0000]tbx25.Value = Format(Date, "dd-mmm-yy")[/COLOR]
[COLOR=#ff0000]tbx26.Value = Format(Date, "dd-mmm-yy")[/COLOR]
[COLOR=#ff0000]With LB_01[/COLOR]
[COLOR=#ff0000]    .List = Sheets("PGSSavingsTimline(Projections)").ListObjects("PGSSTP_tbl").DataBodyRange.Value[/COLOR]
[COLOR=#ff0000]    .ColumnCount = [PGSSTP_tbl].CurrentRegion.Columns.Count[/COLOR]
[COLOR=#ff0000]End With[/COLOR]
[COLOR=#ff0000]End Sub[/COLOR]
 

Robert_Conklin

Board Regular
Joined
Jun 19, 2017
Messages
120
I recorded Macros to find out what the formatting would be for each of the cells. For example: I have two columns on the PGSSC_tbl (5 and 6) that should be in an Custom Format to display the number in millions. Here is what the macro returned:

selection.Numberformat = "0.0,,""MM"" to display the number as 1MM
selection.Numberformat = "_($* #,##0_);_($* (#,##0);_(S* "_"_);_(@_) for the Accounting Format as $ 2,000
and
selection.NumberFormat = _($* #,##0, "K";_($* #,##0,"K");_($* "_");_(@_) to display the amount as 175K

I am assuming that my post above is incorrect. How do I implement these formats into the three sheets? Everything that I have looked up has the code declaring an active sheet, but I was under the impression that you can only have one active sheet in a Sub.
 

Robert_Conklin

Board Regular
Joined
Jun 19, 2017
Messages
120
That solution did not work. I changed each column to a number, then saved/closed the document. Then I reformatted the columns back to what they were at the same time, then saved/closed the document. I re-opened the document and tried running my code, but that solution did not work. The new row copied all formulae from the line above, and posted all data to the correct cells, but the conditional formatting did not copy down from the line above.
 

Forum statistics

Threads
1,082,271
Messages
5,364,153
Members
400,783
Latest member
sambills

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top