PDA

View Full Version : Solved: Adjusting If-Then statement in code



Anomandaris
12-15-2009, 02:58 AM
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


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


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



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

Bob Phillips
12-15-2009, 08:02 AM
It seems to do the same on #'2 as the others, AFAICS. What do you think it should be doing?

Anomandaris
12-15-2009, 08:40 AM
On #2 it should be different it should use the following. Thats because 'A3 is blank'...so there are no formulae to copy to the next empty row.




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



Thanks for looking at this xld...now i've got hope of solving this :) !

Bob Phillips
12-15-2009, 08:55 AM
Ahh, okay I see. When I ran it it created data in row 3, but as you say, it wasn't formulae.

I have a meeting in a few minutes, I will look at it on my return.

Bob Phillips
12-15-2009, 10:20 AM
How about this



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 & "Error! Entries for this Date have already been made"
GoTo ExitPoint
End If
If NextRw = 3 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)
NextRw = 4
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

End Sub

Anomandaris
12-15-2009, 03:31 PM
weird, it doesnt do anything, doesnt give me any error message either thanks though i think we're getting close

Bob Phillips
12-15-2009, 04:06 PM
Nothing happens at present because none of the items on the Summary sheet are GBP. I had to change the data to test it.

Anomandaris
12-16-2009, 02:14 AM
haha you're right, i didnt realize that... But now it makes 2 entries for CTA2, I need just 1 entry for each date...

Any idea on how to limit it to just the first entry?

thanks

Bob Phillips
12-16-2009, 03:36 AM
Is it just?



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 & "Error! Entries for this Date have already been made"
Goto ExitPoint
End If
If NextRw = 3 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)
NextRw = 4
Else

.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 If
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

End Sub

Anomandaris
12-16-2009, 07:06 AM
It works! hmm weird the code looks the same as the one before..

thanks a lot xld

I'll mark this as solved, (however I may need to make aother addition later...I'll try it myself first, if i fail then i'll make a new post

good work my friend

Anomandaris
12-16-2009, 07:08 AM
i see the difference now ---its the Else statement.. that makes sense