PDA

View Full Version : Solved: vba to make formulas work



Anomandaris
10-26-2009, 01:17 AM
HI guys,

I have a macro that copies two cells of data into a new row on a worksheet. Now I need the other columns on that new row to get filled. Formulas are already in place, but i need the macro to somehow recognize that the range in Column A and B have changed, i.e an extra row is there, so it has to perform calculations for that.

please check worksheet (Fund1), its quite simple to understand. Columns C to F have formulae that I need to calculate, instead of manually dragging it down everytime i import a new row of data.

And Ignore Sheet 'Filter'.

Any help would be greatly appreciated, ive been stuck on this for a while I think a slight tweak could do the trick here



Public Sub Example()
Dim wsSource As Worksheet, wsA As Worksheet, wsB As Worksheet, wsOutput As Worksheet
Dim rngCell As Range, rngData As Range
Dim LR As Long: LR = Range("A" & Rows.Count).End(xlUp).Row
On Error GoTo ExitPoint
Set wsSource = Sheets("Import")
Set wsA = Sheets("Fund1")
Set wsB = Sheets("Filter")
With wsSource
Set rngData = .Range(.Cells(2, "C"), .Cells(.Rows.Count, "C").End(xlUp))
End With
For Each rngCell In rngData.SpecialCells(xlCellTypeConstants, xlNumbers)
If UCase(rngCell.Offset(, 4)) = "USD" Then
Select Case rngCell.Offset(, -2)
Case 323
Set wsOutput = wsA
Case 540
Set wsOutput = wsB
End Select

If Not wsOutput Is Nothing Then
With wsOutput.Cells(wsOutput.Rows.Count, "A").End(xlUp).Offset(1)
.Value = rngCell.Value
.Offset(, 1).Value = rngCell.Offset(, 2).Value
.Offset(-2, 2).Resize(2, 4).Formula = .Offset(-3, 2).Resize(2, 4).Formula
Sheets("Fund1").Range("C3:F3").Copy Range("C4:F" & LR)
End With
End If
End If
Set wsOutput = Nothing
Next rngCell
ExitPoint:
Set wsA = Nothing
Set wsB = Nothing
Set wsSource = Nothing
End Sub

Bob Phillips
10-26-2009, 01:21 AM
No workbook attached.

Anomandaris
10-26-2009, 01:21 AM
heres the attachment

Anomandaris
10-26-2009, 02:19 AM
i've figured out the adjustment, I'll post the macro here for whoever's interested

Thanks


Public Sub Examp()
Dim wsSource As Worksheet, wsA As Worksheet, wsB As Worksheet, wsOutput As Worksheet
Dim rngCell As Range, rngData As Range
Dim NextRw As Long
On Error GoTo ExitPoint
Set wsSource = Sheets("Import")
Set wsA = Sheets("Fund1")
Set wsB = Sheets("Filter")
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(, 4)) = "USD" Then
Select Case rngCell.Offset(, -2)
Case 323: Set wsOutput = wsA
Case 540: Set wsOutput = wsB
End Select
If Not wsOutput Is Nothing Then
With wsOutput
NextRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(NextRw, 1).Value = rngCell.Value
.Cells(NextRw, 2).Value = rngCell.Offset(, 2).Value
.Range(.Cells(NextRw, 3), .Cells(NextRw, 6)).FormulaR1C1 = _
.Range(.Cells(NextRw - 1, 3), .Cells(NextRw - 1, 6)).FormulaR1C1
End With
End If
End If
Set wsOutput = Nothing
Next rngCell
ExitPoint:
Set wsA = Nothing
Set wsB = Nothing
Set wsSource = Nothing
End Sub