For time calculation in macro




Dim shtcount, mshtcount, i, counter As Integer
'for timer
Dim StartTime As Double
Dim SecondsElapsed As Double
'Remember time when macro starts
  StartTime = Timer

'code 

SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

-----
'1) to add all excels to summary workbook which contains yes in summary sheet
Sub DoThis()
    Dim shSummary As Worksheet
        Dim c As Range, wbk As Workbook
        Set shSummary = Sheets("Summary")
        With Summary
        For Each c In shSummary.Range("B1:" & shSummary.Range("B1").End(xlDown).Address)
            If UCase(c.Value) = UCase("YES") Then
                If dir("\\s\d\Desktop\ALL indexs\" & c.Previous & ".xlsx") <> "" Then
                    Sheets.Add after:=Sheets(Sheets.count)
                    ActiveSheet.Name = c.Previous
                    Range("E1") = "Difference"
                    Set wbk = Workbooks.Open("\\dg\g\Desktop\ALL indexs\" & c.Previous & ".xlsx")
                    wbk.Sheets(1).UsedRange.Copy ThisWorkbook.ActiveSheet.Range("A1")
                    wbk.Close False
                    Range("E2").Formula = "=c2-d2"
                    Range("E2").AutoFill Range("E2:E" & Range("D1").End(xlDown).Row)
                    Range("E:E").Copy
                    Range("E:E").PasteSpecial xlPasteValues
                    Application.CutCopyMode = False
                    'todo
                    Range("c:e").Select
                    Selection.NumberFormat = "0.00"
                    ActiveSheet.UsedRange.AutoFilter Field:=5, Criteria1:="<=-.02", _
                    Operator:=xlOr, Criteria2:=">=.02"
                    lr = Sheets("remarks").Range("a1").CurrentRegion.Rows.count + 1
                    Sheets(c.Previous.Value).UsedRange.Copy Sheets("Remarks").Range("a" & lr)
                    
                    'Sheets(c.Previous.Value).UsedRange.Copy Sheets("remarks").Range("A" & Sheets("remarks").UsedRange.Rows.count + 1)
                     ActiveSheet.UsedRange.AutoFilter
                End If
            End If
        Next
        End With
        Set shSummary = Nothing
End Sub

Comments

Post a Comment

Popular posts from this blog

number format

  Selection.NumberFormat = "0.00" --------------- =OFFSET(G1094,-1,0)/OFFSET(G1094,-12,0)-1 ---------------- Sub test() ' to select all sheets in the summary workbook Dim i As Long Sheet1.Select For i = 2 To ThisWorkbook.Sheets.Count     If Sheets(i).Name <> "Summary" Then Sheets(i).Select Replace:=False Next i End Sub  --------------- Sub LastRowInOneColumn()  'Find the last used row in a Column: column F in this     Dim LastRow As Long     With ActiveSheet         LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row     End With     MsgBox LastRow End Sub --------------------------------- Sub tests() ' to place vlookup in each and every sheet other than summary Dim i As Long Sheet1.Select For i = 2 To ThisWorkbook.Sheets.Count     If Sheets(i).Name <> "Summary" Then Sheets(i).Select Replace:=False     a = Range("f7").End(xlDown).Row ...
Read more

send Mail by outlook from excel sheet

Sub outlookmailxlsheet()     Dim rng As Range     Dim OutApp As Object     Dim OutMail As Object       Set rng = Nothing     Set rng = Sheets("YourSheet").UsedRange     Set OutApp = CreateObject("Outlook.Application")     Set OutMail = OutApp.CreateItem(0)     On Error Resume Next     With OutMail         .To = "XX@gmail.com"         .CC = ""         .BCC = ""         .Subject = "This is the Subject line"         .HTMLBody = RangetoHTML(rng)         .Send   'or use .Display     End With     With Application         .EnableEvents = True         .ScreenUpdating = True     End With     Set OutMail = Nothing     Set OutApp = Nothing End Sub Fun...
Read more

Find and copy the data

Sub CLE() 'ONEYEAR DATA Sheets("Sheet2").Select 'Range("j10: L110 ").ClearContents 'FSTR = InputBox("Enter the date.. You wanted to See !") lastrow = Sheets("sheet2").UsedRange.Rows.Count On Error GoTo sant For I = 6 To lastrow If Range("C" & I) <> "" Then fstr = Sheets("sheet2").Range("c" & I).Value Sheets("Sheet1").Select             Cells.Find(What:=fstr, After:=ActiveCell, _             LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _             SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate             'ActiveCell.CurrentRegion.Select A = ActiveCell.Row 'MsgBox A + 2 A = A + 2 Range("f" & A).Select     Selection.Copy     Sheets("Sheet2").Select     Range("e" & I).Select     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, ...
Read more