Hi guys
I have a code here that copies formulae into the next empty row (based on certain conditions). Now this code works great for rows A4 and below. But it doesnt work for Row A3 which is the first entry, so I’m trying to add a code that will enter these formulae if A3 is empty.
See the workbook. Data is copied from ‘Summary’ sheet to the CTA# sheets. In sheets CTA1 and CTA3- Cell A3 is filled so the my original code is used.
So below I have my original formula which is fully functional
[VBA]
Public Sub Summary()
Dim wsSource As Worksheet, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, wsOutput As Worksheet
Dim rngCell As Range, rngData As Range
Dim NextRw As Long
On Error GoTo ExitPoint
Application.Calculation = xlCalculationManual
Set wsSource = Sheets("Summary")
Set ws1 = Sheets("CTA1")
Set ws2 = Sheets("CTA2")
Set ws3 = Sheets("CTA3")
With wsSource
Set rngData = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp))
End With
For Each rngCell In rngData.SpecialCells(xlCellTypeConstants, xlNumbers)
If UCase(rngCell.Offset(, 1)) = "GBP" Then
Select Case rngCell.Offset(, -2)
Case 100: Set wsOutput = ws1
Case 200: Set wsOutput = ws2
Case 300: Set wsOutput = ws3
End Select
If Not wsOutput Is Nothing Then
With wsOutput
NextRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
If Not .Range("A2:A" & NextRw - 1).Find(rngCell.Value) Is Nothing Then
MsgBox rngCell.Value & " already entered"
GoTo ExitPoint
End If
.Cells(NextRw, 1).Value = rngCell.Value
.Cells(NextRw, 3).Value = rngCell.Offset(, 6).Value
.Cells(NextRw, 10).Value = rngCell.Offset(, 11).Value
.Range(.Cells(NextRw, 4), .Cells(NextRw, 7)).FormulaR1C1 = _
.Range(.Cells(NextRw - 1, 4), .Cells(NextRw - 1, 7)).FormulaR1C1
.Range(.Cells(NextRw, 9), .Cells(NextRw, 9)).FormulaR1C1 = _
.Range(.Cells(NextRw - 1, 9), .Cells(NextRw - 1, 9)).FormulaR1C1
.Range(.Cells(NextRw, 11), .Cells(NextRw, 13)).FormulaR1C1 = _
.Range(.Cells(NextRw - 1, 11), .Cells(NextRw - 1, 13)).FormulaR1C1
.Range("W26").Value = rngCell.Offset(, 2).Value
.Range("W27:W30").Value = Application.Transpose(rngCell.Offset(, 7).Resize(, 4).Value)
.Range("W31").Value = rngCell.Offset(, 15).Value
End With
End If
End If
Set wsOutput = Nothing
Next rngCell
ExitPoint:
Set ws1 = Nothing
Set ws2 = Nothing
Set ws3 = Nothing
Set wsSource = Nothing
Application.Calculation = xlCalculationAutomatic
[/VBA]
However see sheet CTA2 –Cell ‘A3’ is empty, so I need to have the following code inserted somehow to enter the formulae into Row 3. Any thoughts on how this may be done?
Thanks
[VBA]
If Cells(3,1).Value = "" Then
.Cells(3, 1).Value = rngCell.Value
.Cells(3, 12).Value = rngCell.Offset(, 15).Value
.Cells(3, 15).Value = 0
.Cells(3, 10).Value = rngCell.Offset(, 11).Value
.Range("B3").Formula = "=B2+1"
.Range("D3").Formula = "E2*$Z$3/365"
.Range("E3").Formula = "E2+C3+D3"
.Range("F3").Formula = "100*E3/$E$2"
.Range("G3").Formula = "(E3-E2)/E2"
.Range("H3").Value = "X"
.Range("I3").Formula = "(E3-MAX($E$2:E3))/MAX($E$2:E3)"
.Range("K3").Formula = "J3/E3"
.Range("M3").Formula = "IF((G3<0),"",G3)"
.Range("N3").Formula = "IF((G3>0),"",G3)"
.Range("X26").Value = rngCell.Offset(, 2).Value
.Range("X27:X30").Value = Application.Transpose(rngCell.Offset(, 7).Resize(, 4).Value)
End If
[/VBA]
Reply With Quote
!
