PDA

View Full Version : macro loop through 2 worksheets



asdzxc
05-09-2012, 02:19 AM
After applying macro on Sheet1,go to Sheet2 and to apply the same macro but starting from 'Set cht1 = ActiveSheet.Shapes.AddChart'
plse add code
Dim lastrow As Long
Dim selectnum As Long
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
Select Case True
Case lastrow > 30: selectnum = 30
Case lastrow > 20: selectnum = 20
Case lastrow > 10: selectnum = lastrow
End Select
Cells(lastrow - selectnum + 1, "a").Resize(selectnum, 3).Select
Set cht1 = ActiveSheet.Shapes.AddChart
cht1.Chart.ChartType = xlLineMarkers
cht1.Chart.Location xlLocationAsNewSheet
ActiveChart.ChartArea.Select
ActiveChart.PlotArea.Select
, plse add code

Bob Phillips
05-09-2012, 03:23 AM
Public Sub CreateAllCharte()
Call CreateChart(Worksheets("Sheet1"))
Call CreateChart(Worksheets("Sheet2"))
End Sub

Private Sub CreateChart(ByRef sh As Worksheet)
Dim cht As Object
Dim lastrow As Long
Dim selectnum As Long

With sh

.Select
lastrow = .Cells(.Rows.Count, "a").End(xlUp).Row
Select Case True
Case lastrow > 30: selectnum = 30
Case lastrow > 20: selectnum = 20
Case lastrow > 10: selectnum = lastrow
End Select
.Cells(lastrow - selectnum + 1, "a").Resize(selectnum, 3).Select
Set cht = .Shapes.AddChart
cht.Chart.ChartType = xlLineMarkers
cht.Chart.Location xlLocationAsNewSheet
End With

ActiveChart.ChartArea.Select
ActiveChart.PlotArea.Select
End Sub

asdzxc
05-09-2012, 04:04 AM
Thank you for your vba. I tried the following vba but not working:
Public Sub CreateAllCharte()
Call CreateChart(Worksheets("Sheet1"))
Call CreateChart(Worksheets("Sheet2"))
End Sub
Private Sub CreateChart(ByRef sh As Worksheet)
Sheets("Sheet1").Select
Range("A2").Select
ActiveSheet.Paste
Columns("E:E").Select
Selection.Copy
Columns("B:B").Select
ActiveSheet.Paste
Columns("C:C").Select
Application.CutCopyMode = False
Selection.ClearContents
Columns("A:B").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
ActiveSheet.Paste
Dim i As Long, rng As Range
Columns(1).Insert
With Range("b2", Range("b" & Rows.Count).End(xlUp)).Offset(, -1)
.Formula = "=if(and(weekday(b2,2)<weekday(b3,2),b3<>""""),1,"""")"
.Value = .Value
On Error Resume Next
.SpecialCells(2, 1).EntireRow.Delete
On Error GoTo 0
End With
Columns(1).Delete

With sh
Range("C8").Select
ActiveCell.FormulaR1C1 = "=(R[-3]C2)*2-R[-6]C2"
Dim Lt As Long
Lt = Range("b2").End(xlDown).Offset(3, 0).Row
Selection.AutoFill Destination:=Range("c8:c" & Lt), Type:=xlFillDefault
Range("D4").Select
ActiveCell.FormulaR1C1 = "=ROUND(AVERAGE(R[4]C[-2]:R[6]C[-2]),3)"
Range("D4").Select
Selection.AutoFill Destination:=Range("D4:D35"), Type:=xlFillDefault
Range("D4:D35").Select
Range("E5").Select
ActiveCell.FormulaR1C1 = "=ROUND(AVERAGE(R[-3]C[-3]:R[1]C[-3]),5)"
Range("D4").Select
ActiveCell.FormulaR1C1 = "=ROUND(AVERAGE(R[-2]C[-2]:RC[-2]),3)"
Range("D4").Select
Selection.AutoFill Destination:=Range("D4:D35"), Type:=xlFillDefault
Range("D4:D35").Select
Range("E5").Select
ActiveCell.FormulaR1C1 = "=ROUND(AVERAGE(R[-3]C[-3]:R[1]C[-3]),5)"
Range("E5").Select
ActiveCell.FormulaR1C1 = ""
Range("E6").Select
ActiveCell.FormulaR1C1 = "=ROUND(AVERAGE(R[-4]C[-3]:RC[-3]),5)"
Range("E6").Select
Selection.AutoFill Destination:=Range("E6:E35"), Type:=xlFillDefault
Range("E6:E35").Select
Columns("D:E").Select
Selection.NumberFormat = "0.000"
Range("F11").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-4]<RC[-2],3,0)"
Range("F11").Select
Selection.AutoFill Destination:=Range("F11:F35"), Type:=xlFillDefault
Range("F11:F35").Select
Range("G11").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-5]<RC[-2],5,0)"
Range("G11").Select
Selection.AutoFill Destination:=Range("G11:G34"), Type:=xlFillDefault
Range("G11:G34").Select
Columns("A:A").ColumnWidth = 10
With Range("A" & Rows.Count).End(xlUp)
.AutoFill .Resize(4)

Dim cht As Object
Dim cht1 As Object
Range("C8").Select
ActiveCell.FormulaR1C1 = "=(R[-3]C2)*2-R[-6]C2"
Range("C8").Select
Selection.AutoFill Destination:=Range("C8:C50"), Type:=xlFillDefault
Range("C8:C50").Select
With Range("A" & Rows.Count).End(xlUp)
.AutoFill .Resize(4)

Dim lastrow As Long
Dim selectnum As Long
lastrow = Range("B2").End(xlDown).Offset(3, 0).Row
Select Case True
Case lastrow > 30: selectnum = 30
Case lastrow > 20: selectnum = 20
Case lastrow > 10: selectnum = lastrow
End Select
Cells(lastrow - selectnum + 1, "A").Resize(selectnum, 3).Select
Set cht1 = ActiveSheet.Shapes.AddChart
cht1.chart.ChartType = xlLineMarkers
cht1.chart.Location xlLocationAsNewSheet
ActiveChart.ChartArea.Select
ActiveChart.PlotArea.Select

Dim ValuesArray(), SeriesValues As Variant
Dim Ctr As Integer, TotCtr As Integer
With ActiveChart
For Each x In .SeriesCollection
SeriesValues = x.Values
ReDim Preserve ValuesArray(1 To TotCtr + UBound(SeriesValues))
For Ctr = 1 To UBound(SeriesValues)
ValuesArray(Ctr + TotCtr) = SeriesValues(Ctr)
Next
TotCtr = TotCtr + UBound(SeriesValues)
Next
.Axes(xlValue).MinimumScaleIsAuto = True
.Axes(xlValue).MaximumScaleIsAuto = True
.Axes(xlValue).MinimumScale = Application.Min(ValuesArray)
.Axes(xlValue).MaximumScale = Application.Max(ValuesArray)
End With
End With
End With
End With
End Sub