I don't need the formula on sheet2 to refer to sheet1. I just need to do the
calculations independently. Take a look on my code please, my boss will fire
me if it doesn't work until 5:00 pm. Thanks!
Function LastRow(Sh As Worksheet)
On Error Resume Next
LastRow = Sh.Cells.Find(What:="*", _
After:=Sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function Lastcol(Sh As Worksheet)
On Error Resume Next
Lastcol = Sh.Cells.Find(What:="*", _
After:=Sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
Sub African_American_Report_Macro() 'This step creates the master sheet
combining
'all the sheets in the workbook
'Sub Test2()
Dim Sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Master").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "Master"
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)
Sh.Range("A1").CurrentRegion.Copy DestSh.Cells(Last + 1, "A")
End If
Next
DestSh.Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The sheet Master already exist"
End If
Call Step2 'Calling function Step2
Call Step3 'Calling function Step3
Call Projection
Call Macro1
End Sub
'Sub Test()
'Sub Step2() 'This step delete rows in the Master sheet that
' contains the word composite
Function Step2() 'This step delete rows in the Master sheet that
' contains the word composite
Call DeleteRows("Composite")
End Function
Sub DeleteRows(ByVal DeleteString As String)
Dim wksToSearch As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim rngFirst As Range
Set wksToSearch = Sheets("Master")
Set rngToSearch = wksToSearch.Cells
Set rngFound = rngToSearch.Find(What:=DeleteString, LookAt:=xlWhole)
If rngFound Is Nothing Then
MsgBox "Nothing was found to delete.", vbInformation, "Nothing Found"
Else
Set rngFirst = rngFound
Set rngFoundAll = rngFound.EntireRow
Do
Set rngFoundAll = Union(rngFound.EntireRow, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFirst.Address = rngFound.Address
rngFoundAll.Delete
End If
End Sub
Function Step3() 'This step divides the Master sheet into
' Sheet1 and sheet2 containing Household
' and Persons 18-49.
Dim Sh As Worksheet
Dim SH1 As Worksheet
Dim SH2 As Worksheet
Dim tSH As Worksheet
Dim arr1 As Variant
Dim arr2 As Variant
Dim i As Long
Const sStr1 As String = "household" '<<==== CHANGE
Const sStr2 As String = "Persons 18-49" '<<==== CHANGE
arr1 = Array("household", "Persons 18 - 49")
arr2 = Array("Sheet1", "Sheet2") '<<==== CHANGE
Set Sh = ThisWorkbook.Sheets("MASTER") '<<==== CHANGE
For i = LBound(arr1) To UBound(arr1)
With Sh
.Parent.Sheets(arr2(i)).UsedRange.ClearContents
.AutoFilterMode = False
.Range("A1").AutoFilter Field:=3, Criteria1:=arr1(i)
.AutoFilter.Range.Copy
.Paste Destination:= _
Sh.Parent.Sheets(arr2(i)).Range("A1")
Application.CutCopyMode = False
.Range("A1").AutoFilter
End With
Next i
End Function
Function Projection() 'This step calculates projections, it should be
'done in both of the Sheet1 and Sheet2.
With Worksheets("Sheet1")
.Range("Q2:Q" & Cells(.Rows.Count, 8).End(xlUp).Row).FormulaR1C1 = _
"=IF(RC[-5]=0,-999999,(RC[-4]/(RC[-5]*RC[-9]))*13300)"
End With
With Worksheets("Sheet2")
.Range("Q2:Q" & Cells(.Rows.Count, 8).End(xlUp).Row).FormulaR1C1 = _
"=IF(RC[-5]=0,-999999,(RC[-4]/(RC[-5]*RC[-9]))*13300)"
End With
End Function
Function Macro1()
'
' Macro1 Macro
' Macro recorded 1/3/2006 by dosreisab01
'
' Keyboard Shortcut: Ctrl+q
'
Sheets("Sheet1").Select
Columns("Q:Q").Select
Range("A1:Q3301").Sort Key1:=Range("Q2"), Order1:=xlDescending, Key2:= _
Range("I2"), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom,
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
Sheets("Sheet2").Select
Columns("Q:Q").Select
Range("A1:Q3301").Sort Key1:=Range("Q2"), Order1:=xlDescending, Key2:= _
Range("I2"), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom,
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
Sheets("Sheet1").Select
ActiveWindow.SmallScroll ToRight:=-12
'Range("G2:G29").Select
Range("G2:G28").Select
Selection.Copy
Sheets("Report").Select
Range("B11").Select
ActiveSheet.Paste Link:=True
Sheets("Sheet1").Select
Application.CutCopyMode = False
Range("F2:F28").Select
Selection.Copy
Sheets("Report").Select
Range("C11").Select
ActiveSheet.Paste Link:=True
Sheets("Sheet1").Select
Application.CutCopyMode = False
Range("D2
28").Select
Selection.Copy
Sheets("Report").Select
Range("D11").Select
ActiveSheet.Paste Link:=True
Sheets("Sheet1").Select
Application.CutCopyMode = False
Range("E2:E28").Select
Selection.Copy
Sheets("Report").Select
Range("E11").Select
ActiveSheet.Paste Link:=True
Sheets("Sheet1").Select
Application.CutCopyMode = False
ActiveWindow.SmallScroll ToRight:=3
Range("I1:I28").Select
Selection.Copy
Sheets("Report").Select
Range("F10").Select
ActiveSheet.Paste Link:=True
Sheets("Sheet1").Select
Application.CutCopyMode = False
Range("J1:J28").Select
Selection.Copy
Sheets("Report").Select
Range("G10").Select
ActiveSheet.Paste Link:=True
Sheets("Sheet1").Select
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
Range("Q2:Q28").Select
Selection.Copy
Sheets("Report").Select
Range("H11").Select
ActiveSheet.Paste Link:=True
Sheets("Sheet2").Select
Range("Q2:Q28").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Report").Select
Range("I11").Select
ActiveSheet.Paste Link:=True
End Function
Martin Krastev said:
Do I understand you correctly that you want to put the formula
=IF(L2=0,-999999,M2/L2*H2*13300)
in cell Q2 (and below until the # of rows in col h) of both sheets 1 and 2.
Or you want the formula on sheet2 to refer to cells in sheet1?
Abilio said:
It is still deleting the sheet2 and gives no results
:
Function Projection() 'This step calculates projections, it should be
'done in both of the Sheet1 and Sheet2.
With Worksheets("Sheet1")
.Range("Q2:Q" & .Cells(.Rows.Count, 8).End(xlUp).Row).FormulaR1C1 = _
"=IF(RC[-5]=0,-999999,(RC[-4]/(RC[-5]*RC[-9]))*13300)"
End With
With Worksheets("Sheet2")
.Range("Q2:Q" & .Cells(.Rows.Count, 8).End(xlUp).Row).FormulaR1C1 = _
"=IF(RC[-5]=0,-999999,(RC[-4]/(RC[-5]*RC[-9]))*13300)"
End With
End Function
:
do You mean after & ? if so, It didn't work.
:
I guess you will have to put a dot (".") before Cells!
:
I have this formula that calculates correctly the sheet1 but for some reason
it doesn't calculates the sheet2. I'd appreciate the help.
Function Projection() 'This step calculates projections, it should be
'done in both of the Sheet1 and Sheet2.
With Worksheets("Sheet1")
.Range("Q2:Q" & Cells(.Rows.Count, 8).End(xlUp).Row).FormulaR1C1 = _
"=IF(RC[-5]=0,-999999,(RC[-4]/(RC[-5]*RC[-9]))*13300)"
End With
With Worksheets("Sheet2")
.Range("Q2:Q" & Cells(.Rows.Count, 8).End(xlUp).Row).FormulaR1C1 = _
"=IF(RC[-5]=0,-999999,(RC[-4]/(RC[-5]*RC[-9]))*13300)"
End With
End Function
