Formula cell values not updated, after change another cell value.

Rakesh Kamani

Rakesh Kamani

New Member
Joined
Feb 25, 2020
Messages
33
Office Version
  1. 2013
Platform
  1. Windows
Hello,

I'm facing 2 issues with below code.
1) I have an exiting code, in which the formula is not updated with the cell values after I change the cell value (eg: strFormulea = "= R" & 7 + intX & "C7 * RC9 * RC [-3]"). The formula is available, but it will not be updated automatically, please correct the code and fix the bugs if any.
'Formula updated for O,P & Q and Column S,T & U

2) After clicking on the command button I created new sheets in the same workbook, again when I click on the command button sheets the exit from the generated data is a loss. in this case I have commanted sub 'DelExistSheet ThisWorkbook, strT. Please correct the code in Loop "addSG wD".

Thank you for your support in advance.

VBA Code: 
Private Sub CommandButton1_Click()

'declaring veriables

Dim wB As Workbook

Dim wS As Worksheet
Dim wT As Worksheet
Dim wD As Worksheet ' Create new FG sheet
Dim wDB As Worksheet


'Variable for Rows, Columns
Dim strF As String  'String variables for the filter name
Dim strT As String
Dim strTemp As String
Dim intI As Integer
Dim intJ As Integer
Dim intC As Integer
Dim intS As Integer
Dim intR As Integer
Dim intX As Integer
Dim intY As Integer
Dim intIndex As Integer


'Variable for our 04_Component_Sheet data range
Dim rngDB As Range
Dim rngCell As Range


Dim strFormulea As String

On Error Resume Next    'The procedure in which the On Error statement is used catches the error, even when other procedures are called

    With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    End With
    
'Assigning sheet names, that has data available
Set wS = ThisWorkbook.Worksheets("Source_Sheet")
Set wT = ThisWorkbook.Worksheets("template_Sheet")
Set wDB = ThisWorkbook.Worksheets("04_Component_Sheet")


Set rngDB = wDB.Range("B85:B188")


'Assign values where search criteria for filtering
strF = "FG"
intS = 1
intI = 0
intJ = 0

Do  'loop until all rows have been parsed
   If wS.Range("A7").Offset(intI, 0).Value = "" Or wS.Range("A7").Offset(intI, 0).Value = "EoF" Then Exit Do
   strT = wS.Range("A7").Offset(intI, 0).Value  'FG value set to strT variable
   If VBA.InStr(1, strT, strF) Then     'If the Value does not exist then...
   
   
  'DelExistSheet ThisWorkbook, strT
  
  intIndex = getSheetIndex(ThisWorkbook, strT)
  If intIndex < 1 Then
  
  
  'To add new sheet, if there is no exiting sheet for the given Functional Group
    'Set wD = ThisWorkbook.Worksheets.Add(after:=wS)
   Set wD = Worksheets.Add(after:=Worksheets(Worksheets.Count))
      intJ = 1
      Do
      
         If VBA.InStr(1, wS.Range("A7").Offset(intI + intJ, 0).Value, strF) Or VBA.InStr(1, wS.Range("A7").Offset(intI + intJ, 0).Value, "EoF") Then Exit Do
         
          'intC = 0
         intJ = intJ + 1
         
      
      Loop
      intC = intJ - 1
      wD.Name = strT
      
      'To add header row from template sheet to each added FG sheets
      
      wT.Range("A1:V6").Copy wD.Range("A1")
      
      'copying rows from Source_Sheet, one by one add pasting to next available line on Created FG sheet
      'the Offset Property returned a Range Object shifted 1 row down, and the resize property further retuned a range object of one row smaller, so as not to remove haedings
      wS.Range("A7").Offset(intI + 1, 0).Resize(intC, 1).Copy wD.Range("B7")
      wS.Range("I7").Offset(intI + 1, 0).Resize(intC, 1).Copy wD.Range("A7")
      wS.Range("B7").Offset(intI + 1, 0).Resize(intC, 1).Copy wD.Range("C7")
      wS.Range("C7").Offset(intI + 1, 0).Resize(intC, 1).Copy wD.Range("D7")
      
      'wD.Range("F7").Resize(intC).Value = wS.Range("L7").Offset(intI + 1, 0).Resize(intC, 1).Value
      
      'wD.Range("G7").Resize(intC).Value = wS.Range("V7").Offset(intI + 1, 0).Resize(intC, 1).Value


     'Set a placeholder value for intX
      intX = 0
      Do    'Start the loop
         If wD.Range("A7").Offset(intX, 0).Value = "" Then Exit Do
         
         For Each rngCell In rngDB
            'Check to see if end of list.  if so, exit loop
            'VBA Instr Function checks if a string of text is found in another string of text.
            'It returns 0 if the text is not found. Otherwise it returns the character position where the text is found.
            'The Instr Function performs exact matches.
            If VBA.InStr(1, rngCell.Value, wD.Range("A7").Offset(intX, 0).Value) Then
               
               intR = rngCell.Row
               intY = rngCell.MergeArea.Cells.Count
             
               Exit For
            End If  'GoTo EndofLoop
         
         Next rngCell
         
        
         wD.Range("A7").Offset(intX + 1, 0).Resize(intY - 1, 26).Insert Shift:=xlDown
         
         wD.Range("H7").Offset(intX, 0).Resize(intY, 1).Value = wDB.Cells(intR, 4).Resize(intY, 1).Value
         
         wD.Range("I7").Offset(intX, 0).Resize(intY, 1).Value = wDB.Cells(intR, 5).Resize(intY, 1).Value
         
         
         strFormulea = "= VLOOKUP(RC[-5],'Source_Sheet'!R5C9:R83C22,4,0)"
         wD.Range("F7").Offset(intX, 0).Resize(intY, 1).FormulaR1C1 = strFormulea
         
 
         strFormulea = "= VLOOKUP(RC[-6],'Source_Sheet'!R5C9:R83C22,14,0)"
         wD.Range("G7").Offset(intX, 0).Resize(intY, 1).FormulaR1C1 = strFormulea
         
         'Formula updated for O,P & Q
         strFormulea = "=R" & 7 + intX & "C7*RC9*RC[-3]"
         wD.Range("O7").Offset(intX, 0).Resize(intY, 3).FormulaR1C1 = strFormulea
         
           'Formula updated for "S"
                    strFormulea = "=IF(RC[-1]<>" & """""" & ",VLOOKUP(RC[-1],'07_Safety_Sheet'!R18C2:R40C3,2,FALSE),0)"
         wD.Range("S7").Offset(intX, 0).Resize(intY, 1).FormulaR1C1 = strFormulea

      
         'Formula updated for "T" & "U"
            strFormulea = "=RC[-5]*(100%-RC[-1])"
         
            wD.Range("T7").Offset(intX, 0).Resize(intY, 1).FormulaR1C1 = strFormulea
            
            strFormulea = "=RC[-5]*(100%-RC[-2])"
            
            wD.Range("U7").Offset(intX, 0).Resize(intY, 1).FormulaR1C1 = strFormulea

         
         intX = intX + intY
         
      Loop
      'Set a placeholder value for intX
      intX = 0
      
      Do    'Start the loop
      
         If wD.Range("H7").Offset(intX, 0).Value = "" Then Exit Do
         'Set a placeholder value for intY
         intY = 1
         
         Do
            'Check to see if end of list.  if so, exit loop
            If wD.Cells(7 + intX + intY, 1).Value <> "" Or wD.Range("H7").Offset(intX + intY, 0).Value = "" Then Exit Do
            intY = intY + 1
            
         
         Loop
       'Merge Column cells from A to G
         wD.Cells(7 + intX, 1).Resize(intY, 1).Merge
         wD.Cells(7 + intX, 1).Resize(intY, 1).HorizontalAlignment = xlCenter
         wD.Cells(7 + intX, 1).Resize(intY, 1).VerticalAlignment = xlCenter

         wD.Cells(7 + intX, 2).Resize(intY, 1).Merge
         wD.Cells(7 + intX, 2).Resize(intY, 1).HorizontalAlignment = xlCenter
         wD.Cells(7 + intX, 2).Resize(intY, 1).VerticalAlignment = xlCenter
         
         wD.Cells(7 + intX, 3).Resize(intY, 1).Merge
         wD.Cells(7 + intX, 3).Resize(intY, 1).HorizontalAlignment = xlCenter
         wD.Cells(7 + intX, 3).Resize(intY, 1).VerticalAlignment = xlCenter
         
         wD.Cells(7 + intX, 4).Resize(intY, 1).Merge
         wD.Cells(7 + intX, 4).Resize(intY, 1).HorizontalAlignment = xlCenter
         wD.Cells(7 + intX, 4).Resize(intY, 1).VerticalAlignment = xlCenter
         
         wD.Cells(7 + intX, 5).Resize(intY, 1).Merge
         wD.Cells(7 + intX, 5).Resize(intY, 1).HorizontalAlignment = xlCenter
         wD.Cells(7 + intX, 5).Resize(intY, 1).VerticalAlignment = xlCenter
         
         wD.Cells(7 + intX, 6).Resize(intY, 1).Merge
         wD.Cells(7 + intX, 6).Resize(intY, 1).HorizontalAlignment = xlCenter
         wD.Cells(7 + intX, 6).Resize(intY, 1).VerticalAlignment = xlCenter
         
         wD.Cells(7 + intX, 7).Resize(intY, 1).Merge
         wD.Cells(7 + intX, 7).Resize(intY, 1).HorizontalAlignment = xlCenter
         wD.Cells(7 + intX, 7).Resize(intY, 1).VerticalAlignment = xlCenter
         intX = intX + intY '+ 1
      
      Loop
      
      addSG wD
      
      Else
      
        Set wD = ThisWorkbook.Worksheets(intIndex)
        addSG wD
        
        intJ = 1
        Do
        
           If VBA.InStr(1, wS.Range("A7").Offset(intI + intJ, 0).Value, strF) Or VBA.InStr(1, wS.Range("A7").Offset(intI + intJ, 0).Value, "EoF") Then Exit Do
        
      intJ = intJ + 1
      
      
      Loop
 

      'GoTo EndofLoop
   End If
   
   End If
   
   
   intI = intI + intJ
Loop
'Application.ScreenUpdating = True  'This is not too important but can speed things up a bit by disabling the updating of the screen which otherwise frequently happens
With Application
    .ScreenUpdating = True  'If this is not done the screen may be "dead" after the code finishes
    .DisplayAlerts = False  'We turn off being alerted
End With

MsgBox "created Functional Group from Source_Sheet"


End Sub

Sub DelExistSheet(wB As Workbook, sheetName As String)

    On Error Resume Next
    
    Dim wS As Worksheet
    
    Set wS = wB.Worksheets(sheetName)
    
    wS.Delete

End Sub

Sub addSG(wS As Worksheet) ',addType as integer)

Dim wSG As Worksheet
Dim intI As Integer
Dim intR As Long
Dim intX As Integer
Dim rngSrc As Range

Set wSG = ThisWorkbook.Worksheets("07_Safety_Sheet")
intR = wS.UsedRange.Rows.Count

intI = 0
intX = 0
Set rngSrc = wS.Range("K5:V" & intR)
'Select Case addType

'Case 0

Do

    If wSG.Range("A5").Offset(intI, 0).Value = "" Then Exit Do
    
        rngSrc.Copy
        wS.Cells(5, 11 + intX).PasteSpecial xlPasteAll
        
        wS.Cells(5, 11 + intX) = wSG.Range("A5").Offset(intI, 0).Value & "-goal statement"
        wS.Cells(5, 11 + intX).Resize(1, 12).Merge
        
            intI = intI + 1
            intX = intX + 12
            Loop
            
        'Case 1
        '
        '
        'End Select
        

End Sub

Function getSheetIndex(wB As Workbook, sheetName As String)

On Error Resume Next

Dim wS As Worksheet

getSheetIndex = -1

getSheetIndex = wB.Worksheets(sheetName).Index


End Function
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
You must log in or register to reply here.

Similar threads

Rakesh Kamani
  • Solved
How to Copy and paste particular Columns in the Same worksheet based on Cell values from another worksheet
Replies
1
Views
684
Rakesh Kamani
Rakesh Kamani
Rakesh Kamani
  • Solved
Due to Vlookup formula unable to copy cell value
2
Replies
15
Views
1K
Rakesh Kamani
Rakesh Kamani
B
  • Solved
VBA to check if worksheet exists
Replies
8
Views
314
bdt
B
cpg84
  • Question Question
Merging and unmerging cells based on another cell's value
Replies
2
Views
293
cpg84
cpg84
C
  • Solved
Updating a specific cell value in an autofiltered table
Replies
3
Views
491
skillilea
S

Forum statistics

Threads
1,223,903
Messages
6,175,286
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