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

[Rakesh Kamani]

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.

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