PauseAmacro

Pause A macro

TIME YOU CAN CHANGE TO YOUR REQUIREMENTS

Sub PauseAmacroFor3sec()
Application.Wait (Now + TimeValue("0:00:05"))
 Application.SendKeys "{ENTER}" 'you can use any in place of enter
End Sub

ADVANCE VBA

SOME USEFUL VBA

learn how to use IsFileOpen or similar codes

   ---------------------------------------------------------

Sub MARK_NO_COPY()
'correction required program not ok
Dim ret
ret = IsWorkBookOpen("D:\6571 PETRO\hot case\inspection call 9-09-2019.xlsm")
If ret = True Then
    
   Dim answer As VbMsgBoxResult
answer = MsgBox("insp call file is not opened", vbYesNo + vbQuestion + vbDefaultButton2, "may I open ?")
If answer = vbYes Then
    'Workbooks.Open ("D:\6571 PETRO\hot case\inspection call 9-09-2019.xlsm")
    Windows("inspection call 9-09-2019.xlsm").Activate
    Range("B9").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("Copy Petrofac0001.xlsm").Activate
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("D4").Select
'Workbooks("inspection call 9-07-2019 (Repaired).xlsm").Close (True)
Else
    MsgBox " file is closed"
Exit Sub
End If
Else
    MsgBox " file NOT found"
End If
End Sub

USEFUL VBA

SOME RANDOM VBA CODES CAN BE USED AS NEEDED

NOTE: Use, only if you have a good VBA coding experience.

 -------------------------------------------------------
Sub BOM_ASFAR() 'THIS MACRO COPY'S "PROFILE" TO FIND FILE WORKBOOK
     

        'Application.ScreenUpdating = False

     

        Dim myFile As String, myPath As String, 
        myExtension As String

        Dim wb As Workbook

        Dim i As Long, k As Long

        Dim iLastRow As Long, kLastRow As Long

        Dim myValue As Variant

        Const StartRow As Byte = 10

        Dim mystore As Double

 

        myPath = "E:\Redirect\un.singh\Desktop\BOM\"

        myExtension = "*.xls*"

        myFile = Dir(myPath & myExtension)

    Dim xRet As Boolean

    xRet = IsWorkBookOpen(myFile)

    If xRet = False Then

    Do While myFile <> ""

 

    On Error Resume Next

   

    Set wb = Workbooks.Open(Filename:=myPath & myFile)

    wb.Worksheets("ASSEMBLY_LIST").Select

'Start:

        iLastRow = Range("A" & StartRow).End(xlDown).Row

        kLastRow = Range("K" & StartRow).End(xlDown).Row

        For k = StartRow To kLastRow

        For i = StartRow To iLastRow

     

        myValue = Range("C" & i).Value

                If myValue = Range("K" & k).Value Then

                mystore = mystore + Range("H" & i).Value

                Else

                End If

        Next i

        Range("P" & k).Value = mystore

           

        mystore = 0

        Next k

                   

         Call Macro14

             

        Application.CutCopyMode = False

       ' If myFile <> "DP16004-CS-PBOM-1137A_R0_20190603 (VBA Platform).xlsm" Then    'NEW

        wb.Close savechanges:=True

       ' Else      'NEW

       ' End If    'NEW

             

    myFile = Dir()

    Loop

 

    Call Macro13

Else

    'Worksheets("ASSEMBLY_LIST").Select

    'GoTo Start

    MsgBox "pl close file BOM"

End If

 

   'Application.ScreenUpdating = True

End Sub

Sub Macro13() ' SHALL BE USED WITH MACRO "myFileopen1" SEE ABOVE

' Macro13 Macro

'1)REMOVE DUPLICATE PROFILES

    Sheets("Sheet2").Select

    Range("A3").Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-78

    Range("H3").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Range("H3").Select

    ActiveSheet.Range(Selection, Selection.End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlYes

'2)CONSOLIDATE WT OF "F" AND WRITE IN COLOUMN "I"

    Dim myFile As String

    Dim i As Long, h As Long

    Dim iLastRow As Long, hLastRow As Long

    Dim myValue As Variant

    Const StartRow As Byte = 3

    Dim mystore As Double

    iLastRow = Range("A" & StartRow).End(xlDown).Row

    hLastRow = Range("H" & StartRow).End(xlDown).Row

 

For h = StartRow To hLastRow

        For i = StartRow To iLastRow

                myValue = Range("A" & i).Value

                If myValue = Range("H" & h).Value Then

                    mystore = mystore + Range("A" & i).Offset(, 5).Value

                Else

                End If

        Next i

     

        Range("I" & h).Value = mystore

        mystore = 0

Next h

End Sub

Sub Macro14() ' SHALL BE USED WITH MACRO "myFileopen1" SEE ABOVE

' Macro13 Macro

    Range("K8").Select

    Selection.End(xlDown).Select

    Range(Selection, Selection.End(xlDown)).Select

    Range(Selection, Selection.End(xlToRight)).Select

    Selection.Copy

 

    Windows("FINDFILE.xlsm").Activate

   

    Range("A1").Select

    Selection.End(xlDown).Select

    Selection.Offset(1, 0).Select

 

    ActiveSheet.Paste

 

End Sub

ADD PASSWORD

ADD PASSWORD TO EXCEL WORKBOOK

The below code will ask you to enter the password, as you try to open it. after putting the password it will show a message welcome. you can put your password in place of 123
Simply copy below code and paste in excel module.

Private Sub Workbook_Open()

a = InputBox("Enter the Password")

If a = 123 Then
 MsgBox " Welcome"
Else
 MsgBox "Incorrect Password"
 ThisWorkbook.Save
 ThisWorkbook.Close
End If

End Sub

Password Breaker

Remove password from your excel workbook sheet, not a workbook. please remember.

Sub PasswordBreaker()

Dim i As Integer, j As Integer, k As Integer

Dim l As Integer, m As Integer, n As Integer

Dim i1 As Integer, i2 As Integer, i3 As Integer

Dim i4 As Integer, i5 As Integer, i6 As Integer

On Error Resume Next

For i = 65 To 66: For j = 65 To 66: For k = 65 To 66

For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66

For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66

For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126

ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

If ActiveSheet.ProtectContents = False Then

Exit Sub

'MsgBox “One usable password is” & Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

Else: End If

Next: Next: Next: Next: Next: Next

Next: Next: Next: Next: Next: Next

End Sub

 ----------------------------------------------------------------------------------------

TOP VBA

EXCEL-VBA FOR QC ENGINEERS

GET FILE NAME IN EXCEL BY VBA

If you have several files in a folder and you want
 to write each file name in excel worksheet 

then below is the code.  

 --------------------------------------------

Private Sub Workbook_Open()

 Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents

Dim FLD As Office.FileDialog
Set FLD = Application.FileDialog(msoFileDialogFolderPicker)

FLD.Show

Dim P As String
P = FLD.SelectedItems(1)

Dim FSO As Scripting.FileSystemObject
Set FSO = New FileSystemObject

Dim FOL As Scripting.Folder
Set FOL = FSO.GetFolder(P)

Dim F As Scripting.File
Dim r As Long

r = 2

For Each F In FOL.Files

    Cells(r, 1).Value = F.Name
    r = r + 1
 
Next F

End Sub

SAW WELDING

WHAT IS SAW WELDING, TYPES, USES, AND ITS ADVANTAGE AND DISADVANTAGE

In this process, an arc is maintained between a continuously fed bare wire electrode and the workpiece underneath a mass of fusible granular flux. The flux is dispensed over the joint area and the wire is fed into it.  The arc which forms melts a proportion of the flux, which protects the weld pool from atmospheric contamination, shields the remaining unmelted flux acts as a shield for the arc itself.  The power source may provide either alternating or direct current.   Highest deposition. rates are obtained with electrode negative, but control of bead shape and penetration is better with electrode positive.