hi can any body help me
i run allsheets code as below and it takes long time for example i had 800 sheets and it takes time about 4 hours of me
i think it can be shorter and better
please help me to gather all in one code
Sub formula()
LR = Cells(Rows.Count, "a").End(xlUp).Row
Set yl = Range("b1:b" & LR)
yl.Copy Range("q1")
Range("m2:m" & LR) = "=IF(L2-E2=L2 ,"""",IF(L2-E2=-E2,"""",L2-E2))"
Range("q1:q" & LR).RemoveDuplicates Columns:=1, Header:=xlYes
clr = Cells(Rows.Count, "q").End(xlUp).Row
Range("r1") = "Average"
Range("r2:r" & clr) = "=AVERAGEIFS($M$2:$M$" & LR & ",$B$2:$B$" & LR & ",Q2)"
End Sub
Sub Chart1()
Dim ydata As Range
Dim xdata As Range
Set ch = ActiveSheet.ChartObjects.Add(Left:=100, Width:=400, Top:=100, Height:=250)
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "q").End(xlUp).Row
Set xdata = ActiveSheet.Range("Q2:Q" & LastRow)
Set ydata = ActiveSheet.Range("R2:R" & LastRow)
With ch.Chart
.SeriesCollection.NewSeries
.FullSeriesCollection(1).XValues = xdata
.FullSeriesCollection(1).Values = ydata
.ChartType = xlXYScatterLines
.ChartArea.Border.Color = vbRed
.ChartArea.Border.Weight = 3.25
ActiveWorkbook.Save
End With
End Sub
Sub ReplaceDivError()
Dim r As Range
Dim c As Range
Dim lr As Integer
lr = Cells(Rows.Count, "r").End(xlUp).Row
Set r = Range("r2:r" & lr)
For Each c In r
If IsError(c.Value) Then
If c.Value = CVErr(xlErrDiv0) Then
c.Value = ""
End If
End If
Next c
End Sub
Sub AllSheets()
For Each ws In ThisWorkbook.Worksheets
ws.Activate
Call formula
Call Chart1
Call ReplaceDivError
Next ws
End Sub
Than k you so much
Bookmarks