MICROSOFT KE MASTER BANO BY A.K.V: 2021

Friday, December 31, 2021

Script date time function by coading

Thursday, December 30, 2021

Google sheet ke script date formula

Saturday, December 4, 2021

Blinking sheet by color

function onEdit(e)

{

var ss = SpreadsheetApp.getActiveSpreadsheet();

var mysheet = ss.getSheetByName("Working Sheet Glue dept.");

if( activeCell == "i4" )

var activeCell = ss.getActiveCell().getA1Notation();

{

for(var i=0;i<50;i++)

{

if( i%2 == 0 )

mysheet.getRange("i4").setBackground("GREEN");

else

mysheet.getRange("i4").setBackground("WHITE");

SpreadsheetApp.flush();

Utilities.sleep(500);

}

Details aakash verma

Connection data

https://docs.google.com/spreadsheets/d/1BVxe7WHRyKnJzvosExEGk8U2aCUcxPn9k7Hx4yv23hY/edit?usp=sharing

Master

https://docs.google.com/spreadsheets/d/1lFw6s1xhARnOam0f1G3axnIgv-phIDGKGftpIRuZ5WM/edit?usp=sharing

Stock

https://docs.google.com/spreadsheets/d/1mdhU9uAbmci2KjdMtvYckstVc4gIWu5uDvtjSvG-YMs/edit?usp=sharing

Wednesday, December 1, 2021

ENGLISH LEARN WITH ADVANCE VOCABULARY

Home

▼

Saturday, November 20, 2021

MAIL ID:- brpentpvtltd@gmail.com

Pass. sonu@9999661903

BHARAT PAY

ZOMATO

(NEWS AGE BHARAT PAY)

new_age_bakers

PASSWORD : 8076021725

(BHARAT PAY)

puri_baker_8595627478

8595627478

PURIBAKERS.PVT.LTD

PAS : PURI2015

at November 20, 2021

No comments:

Advance formula of Google sheet

1.=D4+ SUMIFS(Sheet2!$L$3:$L,Sheet2!$J$3:$J,$B$4:$B)+sumifs(RETURN!$E$3:$E,RETURN!$C$3:$C,B4)-sumifs (TRANSFER!$E$3:$E,TRANSFER!$C$3:$C,B4)

2. =ARRAYFORMULA(IFERROR(VLOOKUP(C3:C,Sheet2!$B$4:$C,2,0),""))

3. =ARRAYFORMULA(if(B4:B,"PPF-RL-"&row(B2:B)-1+10000,""))

4. =IF(H4="PE",G4,IF(H4="PP",G4,IF(H4="PE PP",G4,"")))

5. =IF(H4="PE PP",G4,IF(H4="PP",G4,""))

6. =IFERROR(M4*N4/1000," ")

7. =ARRAYFORMULA(IF(O4:O=0,"PENDING","Complete"))

8. =ARRAYFORMULA(IF(P4:P="COMPLETE", HYPERLINK("https://docs.google.com/forms/d/e/1FAIpQLSd8DQvOYP3bWg0pojmdRI1a9lwJCqnspnn8ZW_iA0JVXr-iHQ/viewform?usp=pp_url&entry.2009608542="&A4:A&"&entry.820423580="&J4:J&"&entry.1551706892="&C4:C&"&entry.2022927099="&D4:D&"&entry.1318474386="&L4:L&"","Open"),""))

9. =ArrayFormula(if(C3:C="","",row(C3:C)-1))

10. =iferror(VLOOKUP(C3,'PPF PCS -IMS'!$B$4:$C$2503,2,0),)

11. =iferror(SUM(filter(IMPORTRANGE("https://docs.google.com/spreadsheets/d/1qqfPKw6B2Cxn6veN1Y0oq-4RaXfiYRLjdzotVWeT42A/edit#gid=0","Transfer!$d$214:$d"),IMPORTRANGE("https://docs.google.com/spreadsheets/d/1qqfPKw6B2Cxn6veN1Y0oq-4RaXfiYRLjdzotVWeT42A/edit#gid=0","Transfer!$b$214:$b")=B4)),0)

12. =(D4+E4)-SUMIF('PPF ROLL-PMS'!$E$4:$E$1001,B4,'PPF ROLL-PMS'!$F$4:$F$1001)

13. =iferror(INDEX($X$4:$X$11310,MATCH(I5,$V$4:$V$11310,0)),"")

14. =IF(O1,O1,IF(N1="DONE",NOW(),""))

15. =IF(N1<>"",IF(P1<>"",P1,(NOW()-A1)/24),"")

16. =ARRAYFORMULA(if(B2:B,text(ifna(VLOOKUP(A2:A,{'FORM RESPONSE'!B:B,'FORM RESPONSE'!A:A},2,0),""),"dd-mm-yyyy hh:mm:ss"),""))

17. =ARRAYFORMULA(if(B2:B,IF((M2:M+N2:N)>=L2:L,"Completed","Pending"),""))

18. =ARRAYFORMULA(if(B2:B,if(round(IFna(VLOOKUP(J2:J,Sheet2!$A$2:$E,5,0),"")*H2:H,0),round(IFna(VLOOKUP(J2:J,Sheet2!$A$2:$E,5,0),"")*H2:H,0),"NO DATA"),""))

19. =ARRAYFORMULA(if(B2:B,(G2:G*H2:H)/1000,""))

20. =ARRAYFORMULA(IF(B2:B,ifNA(VLOOKUP($J$2:$J,Sheet2!A1:E,2,0),""),""))

21. =ARRAYFORMULA(IF(O4:O="COMPLETED", HYPERLINK("https://docs.google.com/forms/d/e/1FAIpQLSd8DQvOYP3bWg0pojmdRI1a9lwJCqnspnn8ZW_iA0JVXr-iHQ/viewform?usp=pp_url&entry.2009608542="&A2:A&"&entry.820423580="&J2:J&"&entry.1551706892="&C2:C&"&entry.2022927099="&D2:D&"&entry.1318474386="&L2:L&"","Open"),""))

Saturday, November 27, 2021

Send mail automatic actuall

// This constant is written in column C for rows for which an email

// has been sent successfully.

var EMAIL_SENT = 'EMAIL_SENT';

/**

* Sends non-duplicate emails with data from the current spreadsheet.

function sendEmails2() {

var sheet = SpreadsheetApp.getActiveSheet();

var startRow = 2; // First row of data to process

var numRows = 20; // Number of rows to process

// Fetch the range of cells A2:B3

var dataRange = sheet.getRange(startRow, 1, numRows, 3);

// Fetch values for each row in the Range.

var data = dataRange.getValues();

for (var i = 0; i < data.length; ++i) {

var row = data[i];

var emailAddress = row[0]; // First column

var message = row[1]; // Second column

var emailSent = row[2]; // Third column

if (emailSent !== EMAIL_SENT) { // Prevents sending duplicates

var subject = 'Sending emails from a Spreadsheet';

MailApp.sendEmail(emailAddress, subject, message);

sheet.getRange(startRow + i, 3).setValue(EMAIL_SENT);

// Make sure the cell is updated right away in case the script is interrupted

SpreadsheetApp.flush();

}

Friday, November 26, 2021

Skm inustries joining time

null

22/11/21 se company join kya h mene aur sare documents 10 ka certificate and 12 th ka certificate and computer diploma aur adhar card provision sab jama karwa dya

Tuesday, November 23, 2021

Automatic barcode create

=image("http://chart.googleapis.com/chart?chs=150x150&cht=qr&chl="&A2)

Sunday, August 29, 2021

MULTIPLE IF CONDION BY VBA

Sub IF_LOOP()

For Each Cell In Range("A2:A10")

If Cell.Value = AAKAS Then

Cell.Offset(0, 1).Value = "POSITIVE"

ElseIf Cell.Value = PAWAN Then

Cell.Offset(0, 1).Value = "NEGETIVE"

Else

Cell.Offset(0, 1).Value = ""

End If

Next Cell

End Sub

ONE TIME MULTIPLE RESULT VBA

Sub HIDE()

Dim AAKASH As Integer

For AAKASH = 1 To 10

If Cells(AAKASH, 2).Value = "AAKAS" Then

Cells(AAKASH, 3).Value = "PASS"

Cells(AAKASH, 3).Interior.Color = vbGreen

Else

Cells(AAKASH, 3).Value = ""

Cells(AAKASH, 3).Interior.Color = vbRed

End If

Next AAKASH

End Sub

Monday, July 26, 2021

AUTOMATIC FULL SCREEN

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.DisplayFullScreen = True

End Sub

Wednesday, June 23, 2021

All link skm

Metre reading status

https://forms.gle/omRAUXEEutwnTLKNA

https://docs.google.com/spreadsheets/d/1lFw6s1xhARnOam0f1G3axnIgv-phIDGKGftpIRuZ5WM/edit?usp=sharing

[13/12, 12:36 PM] Aakash: https://docs.google.com/spreadsheets/d/1iTnav4nFzVTrmwOXrSvuLTCxVexZK3kx925QvCQ0SQY/edit?usp=sharing

[13/12, 12:40 PM] Aakash: https://docs.google.com/spreadsheets/d/1iTnav4nFzVTrmwOXrSvuLTCxVexZK3kx925QvCQ0SQY/edit?usp=sharing pms

https://docs.google.com/spreadsheets/d/1Q3npbxo59iJpsvbgkLProRt0YwkS8UEj8IUSZWcrsug/edit?usp=sharing glass ims

https://docs.google.com/spreadsheets/d/1T8m6UXS2Ds7TA6j-0GkPv2vNTTTHEPRLYfwrZ5NAJOs/edit?usp=sharing trasnfer

https://docs.google.com/spreadsheets/d/1xFZH4Qf_5p1ht-NZ24k6YAy5zHqM0oQVe11T6jiq74c/edit?usp=sharing db format

[13/12, 12:42 PM] Aakash: https://docs.google.com/spreadsheets/d/1w9K4Soh41OyN1sATTSisx5Te6d-3aPfMZ4ncX_qLTJM/edit?usp=sharing cnc

https://docs.google.com/spreadsheets/d/16BU3CCXpc_GgE47gTvyuHECN4fF_n9n5iO3rotqjFZY/edit?usp=sharing tray f

https://docs.google.com/spreadsheets/d/1iFIFsf_NUOQ1a2dW3LEuWmmIblEo32LkJtKcDGGHOds/edit?usp=sharing washin

[13/12, 12:43 PM] Aakash: https://docs.google.com/spreadsheets/d/1iFIFsf_NUOQ1a2dW3LEuWmmIblEo32LkJtKcDGGHOds/edit?usp=sharing washin

https://docs.google.com/spreadsheets/d/1a6lkJ2ugmntdGjl1cRb5qGIVhw2QDJ7ITcVAHbHcQuc/edit?usp=sharing tuffon

https://docs.google.com/spreadsheets/d/1bdyWTgRYEKEM5nqASmVx9HeHt5scapb4ZkGoVdWN79I/edit?usp=sharing packaging

https://docs.google.com/spreadsheets/d/1STP76M-4rKcfIeElf2N0LscCb2_x9mtPLn7oFx1bHZQ/edit?usp=sharing

Saturday, May 1, 2021

JUMP CELL IN EXCEL SERIOR WISE

Option Explicit

Sub FONTTEXTLOOP()

Dim COUNTER As Integer

For COUNTER = 1 To 9

ActiveCell.Offset(1, 0).Select

If ActiveCell.Value = 3 Then Exit For

Next COUNTER

End Sub

BY COADING IF FORMULA IN EXCEL

Option Explicit

Sub PASSORFAIL()

Dim MARKS As Byte

MARKS = ActiveCell.Offset(0, -2).Value

Select Case MARKS

Case 0 To 34

ActiveCell.Value = "F"

Case 35 To 49

ActiveCell.Value = "E"

Case Else

ActiveCell.Value = "A"

End Select

End Sub

Sunday, April 11, 2021

ek button se multiple macro assign kare

Sub Button1_Click()
    Call FillEmptyBlankCellWithValue 'Macro1
    Call ReplaceHyperlinks 'Macro2
    Call test 'Macro3
End Sub

specific sheet pe file open hogi excel me by code

Private Sub Workbook_Open()

Worksheets("aa").Activate

Range("b2").Select

End Sub

hide

Application.ExecuteExcel4Macro "show.toobar(""ribbon"",false)"

hide

Private Sub Workbook_Open()

With Application

.ScreenUpdating = False

.Calculation = xlCalculationManual

.ExecuteExcel4Macro "show.toolbar(""ribbon"",false)"

.WindowState = xlNormal

.CommandBars("full screen").Visible = False

.CommandBars("worksheet menue bar").Enabled = False

.DisplayStatusBar = False

.DisplayScrollBars = False

.DisplayFormulaBar = False

.Width = 845

.Height = 408

End With

With ActiveWindow

.DisplayWorkbookTabs = False

.DisplayRuler = False

.DisplayHeadings = False

End With

With Application

.ScreenUpdating = True

.Calculation = xlCalculationAutomatic

End With

End Sub

remove tommbar vba

Private Sub Workbook_Activate()

    Run "RemoveToolbars"

End Sub



Private Sub Workbook_BeforeClose(Cancel As Boolean)

    On Error Resume Next

        Application.CommandBars("MyToolbar").Delete

End Sub



Private Sub Workbook_Deactivate()

    Run "RestoreToolbars"

End Sub

restore excel by vba

Sub RestoreToolbars()

    On Error Resume Next

        With Application

           .DisplayFullScreen = False

           .CommandBars("MyToolbar").Enabled = False

           .CommandBars("Worksheet Menu Bar").Enabled = True

        End With

    On Error GoTo 0

End Sub

hide ribbon in excel by vba

Sub RemoveToolbars()

On Error Resume Next

With Application

.DisplayFullScreen = True

.CommandBars("Full Screen").Visible = False

.CommandBars("MyToolbar").Enabled = True

.CommandBars("MyToolbar").Visible = True

.CommandBars("Worksheet Menu Bar").Enabled = False

End With

On Error GoTo 0

End Sub

Saturday, April 10, 2021

hide all toolbar in excel by vba

Sub RemoveToolbars()

    On Error Resume Next

        With Application

           .DisplayFullScreen = True

           .CommandBars("Full Screen").Visible = False

           .CommandBars("MyToolbar").Enabled = True

           .CommandBars("MyToolbar").Visible = True

           .CommandBars("Worksheet Menu Bar").Enabled = False

        End With

    On Error GoTo 0

End Sub







Sub RestoreToolbars()

    On Error Resume Next

        With Application

           .DisplayFullScreen = False

           .CommandBars("MyToolbar").Enabled = False

           .CommandBars("Worksheet Menu Bar").Enabled = True

        End With

    On Error GoTo 0

End Sub

Friday, February 12, 2021

Number convert into text in excel by coading

Function SpellNumber(amt As Variant) As Variant

Dim FIGURE As Variant

Dim LENFIG As Integer

Dim i As Integer

Dim WORDs(19) As String

Dim tens(9) As String

WORDs(1) = "One"

WORDs(2) = "Two"

WORDs(3) = "Three"

WORDs(4) = "Four"

WORDs(5) = "Five"

WORDs(6) = "Six"

WORDs(7) = "Seven"

WORDs(8) = "Eight"

WORDs(9) = "Nine"

WORDs(10) = "Ten"

WORDs(11) = "Eleven"

WORDs(12) = "Twelve"

WORDs(13) = "Thirteen"

WORDs(14) = "Fourteen"

WORDs(15) = "Fifteen"

WORDs(16) = "Sixteen"

WORDs(17) = "Seventeen"

WORDs(18) = "Eighteen"

WORDs(19) = "Nineteen"

tens(2) = "Twenty"

tens(3) = "Thirty"

tens(4) = "Fourty"

tens(5) = "Fifty"

tens(6) = "Sixty"

tens(7) = "Seventy"

tens(8) = "Eighty"

tens(9) = "Ninety"

FIGURE = amt

FIGURE = Format(FIGURE, "FIXED")

FIGLEN = Len(FIGURE)

If FIGLEN < 12 Then

FIGURE = Space(12 - FIGLEN) & FIGURE

End If

If Val(Left(FIGURE, 9)) > 1 Then

SpellNumber = "Rupees "

ElseIf Val(Left(FIGURE, 9)) = 1 Then

SpellNumber = "Rupee "

End If

For i = 1 To 3

If Val(Left(FIGURE, 2)) < 20 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 2)))

ElseIf Val(Left(FIGURE, 2)) > 19 Then

SpellNumber = SpellNumber & tens(Val(Left(FIGURE, 1)))

SpellNumber = SpellNumber & WORDs(Val(Right(Left(FIGURE, 2), 1)))

End If

If i = 1 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & " Crore "

ElseIf i = 2 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & " Lakh "

ElseIf i = 3 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & " Thousand "

End If

FIGURE = Mid(FIGURE, 3)

Next i

If Val(Left(FIGURE, 1)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 1))) + " Hundred "

End If

FIGURE = Mid(FIGURE, 2)

If Val(Left(FIGURE, 2)) < 20 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 2)))

ElseIf Val(Left(FIGURE, 2)) > 19 Then

SpellNumber = SpellNumber & tens(Val(Left(FIGURE, 1)))

SpellNumber = SpellNumber & WORDs(Val(Right(Left(FIGURE, 2), 1)))

End If

FIGURE = Mid(FIGURE, 4)

If Val(FIGURE) > 0 Then

SpellNumber = SpellNumber & " Paise "

If Val(Left(FIGURE, 2)) < 20 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 2)))

ElseIf Val(Left(FIGURE, 2)) > 19 Then

SpellNumber = SpellNumber & tens(Val(Left(FIGURE, 1)))

SpellNumber = SpellNumber & WORDs(Val(Right(Left(FIGURE, 2), 1)))

End If

FIGURE = amt

FIGURE = Format(FIGURE, "FIXED")

If Val(FIGURE) > 0 Then

SpellNumber = SpellNumber & " Only "

End If

End Function

Thursday, February 11, 2021

Number conbert to spelling iin excel vba

Function NumToWord(ByVal N As Currency) As String

Const Ten = 10@

Const Hundred = Ten * Ten

Const Thousand = Ten * Hundred

Const Lakh = Thousand * Hundred

Const Crore = Lakh * Hundred

Const Million = Thousand * Thousand

Const Billion = Thousand * Million

Const Trillion = Thousand * Billion

If (N = 0@) Then NumToWord = "zero": Exit Function

Dim Buf As String: If (N < 0@) Then Buf = "negative " Else Buf = ""

Dim Frac As Currency: Frac = Abs(N - Fix(N))

If (N < 0@ Or Frac <> 0@) Then N = Abs(Fix(N))

Dim AtLeastOne As Integer: AtLeastOne = N >= 1

If (N >= Crore) Then

Buf = Buf & NumToWordDigitGroup(Int(N / Crore)) & " Crore"

N = N - Int(N / Crore) * Crore

If (N >= 1@) Then Buf = Buf & " "

End If

If (N >= Lakh) Then

Buf = Buf & NumToWordDigitGroup(Int(N / Lakh)) & " Lakh"

N = N - Int(N / Lakh) * Lakh

If (N >= 1@) Then Buf = Buf & " "

End If

If (N >= Thousand) Then

Buf = Buf & NumToWordDigitGroup(N \ Thousand) & " Thousand"

N = N Mod Thousand

If (N >= 1@) Then Buf = Buf & " "

End If

If (N >= Hundred) Then

Buf = Buf & NumToWordDigitGroup(N \ Hundred) & " hundred"

N = N Mod Hundred

If (N >= 1@) Then Buf = Buf & " "

End If

If (N >= 1@) Then

Buf = Buf & NumToWordDigitGroup(N)

End If

NumToWord = Buf

End Function

Private Function NumToWordDigitGroup(ByVal N As Integer) As String

Const Hundred = " hundred"

Const One = "one"

Const Two = "two"

Const Three = "three"

Const Four = "four"

Const Five = "five"

Const Six = "six"

Const Seven = "seven"

Const Eight = "eight"

Const Nine = "nine"

Dim Buf As String: Buf = ""

Dim Flag As Integer: Flag = False

Select Case (N \ 100)

Case 0: Buf = "": Flag = False

Case 1: Buf = One & Hundred: Flag = True

Case 2: Buf = Two & Hundred: Flag = True

Case 3: Buf = Three & Hundred: Flag = True

Case 4: Buf = Four & Hundred: Flag = True

Case 5: Buf = Five & Hundred: Flag = True

Case 6: Buf = Six & Hundred: Flag = True

Case 7: Buf = Seven & Hundred: Flag = True

Case 8: Buf = Eight & Hundred: Flag = True

Case 9: Buf = Nine & Hundred: Flag = True

End Select

If (Flag <> False) Then N = N Mod 100

If (N > 0) Then

If (Flag <> False) Then Buf = Buf & " "

Else

NumToWordDigitGroup = Buf

Exit Function

End If

Select Case (N \ 10)

Case 0, 1: Flag = False

Case 2: Buf = Buf & "twenty": Flag = True

Case 3: Buf = Buf & "thirty": Flag = True

Case 4: Buf = Buf & "forty": Flag = True

Case 5: Buf = Buf & "fifty": Flag = True

Case 6: Buf = Buf & "sixty": Flag = True

Case 7: Buf = Buf & "seventy": Flag = True

Case 8: Buf = Buf & "eighty": Flag = True

Case 9: Buf = Buf & "ninety": Flag = True

End Select

If (Flag <> False) Then N = N Mod 10

If (N > 0) Then

If (Flag <> False) Then Buf = Buf & "-"

Else

NumToWordDigitGroup = Buf

Exit Function

End If

Select Case (N)

Case 0:

Case 1: Buf = Buf & One

Case 2: Buf = Buf & Two

Case 3: Buf = Buf & Three

Case 4: Buf = Buf & Four

Case 5: Buf = Buf & Five

Case 6: Buf = Buf & Six

Case 7: Buf = Buf & Seven

Case 8: Buf = Buf & Eight

Case 9: Buf = Buf & Nine

Case 10: Buf = Buf & "ten"

Case 11: Buf = Buf & "eleven"

Case 12: Buf = Buf & "twelve"

Case 13: Buf = Buf & "thirteen"

Case 14: Buf = Buf & "fourteen"

Case 15: Buf = Buf & "fifteen"

Case 16: Buf = Buf & "sixteen"

Case 17: Buf = Buf & "seventeen"

Case 18: Buf = Buf & "eighteen"

Case 19: Buf = Buf & "nineteen"

End Select

NumToWordDigitGroup = Buf

End Function

Sunday, February 7, 2021

All excel sheet convertinto excel files

Sub SplitEachWorksheet()

Dim FPath As String
FPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
    ws.Copy
    Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Saturday, February 6, 2021

Automatic bill save any location serieal wise

Sub SaveInvoiceWithNewName()

Dim NewFN As Variant

' Copy Invoice to a New Workbook

ActiveSheet.Copy

NewFN = "C:\\" & Range("i5").Value & ".xlsx"

ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook

ActiveWorkbook.Close

NextInvoice

End Sub

Sub NextInvoice()

Range("i5").Value = Range("i5").Value + 1

Range("c5:g5").ClearContents

Range("b10:b20").ClearContents

Range("e10:e20").ClearContents

End Sub

Tuesday, February 2, 2021

Auto highlight column and row by vba cod in excel

'Deepak EduWorld...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Application.ScreenUpdating = False
  Application.FindFormat.Clear
  Application.ReplaceFormat.Clear
  Application.FindFormat.Interior.Color = 65534
  Application.ReplaceFormat.Interior.Color = xlNone
  Cells.Replace "", "", SearchFormat:=True, ReplaceFormat:=True
  Application.FindFormat.Clear
  Application.ReplaceFormat.Clear
  Application.FindFormat.Interior.Color = xlNone
  Application.ReplaceFormat.Interior.Color = 65534
  Target.EntireRow.Replace "", "", SearchFormat:=True, ReplaceFormat:=True
  Target.EntireColumn.Replace "", "", SearchFormat:=True, ReplaceFormat:=True
  Application.FindFormat.Clear
  Application.ReplaceFormat.Clear
  Application.ScreenUpdating = True
End Sub 'Deepak EduWorld...

Sunday, January 24, 2021

automatic delete data from excel sheet by vba

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error Resume Next

Dim Metric As String

Metric = Target.Value

Select Case Metric

Case "my company"

Range("a3:k15").Value = " "

Case "1/1/2022"

Range("a3:d1000").Value = " "

Case "1/2/2022"

Range("a3:d1000").Value = " "

Case "1/3/2022"

Range("a3:d1000").Value = " "

Case "1/5/2022"

Range("a3:d1000").Value = " "

Case "1/7/2022"

Range("a3:d1000").Value = " "

Case "1/9/2022"

Range("a3:d1000").Value = " "

Case "1/11/2022"

Range("a3:d1000").Value = " "

Case "1/12/2022"

Range("a3:d1000").Value = " "

Case "1/13/2022"

Range("a3:d1000").Value = " "

Case "1/14/2022"

Range("a3:d1000").Value = " "

Case "1/15/2022"

Range("a3:d1000").Value = " "

Case "1/16/2022"

Range("a3:d1000").Value = " "

Case "2/16/2022"

Range("a3:d1000").Value = " "

Case "2/16/2022"

Range("a3:d1000").Value = " "

End Select

End Sub

active cell highlight in excel by vba coading

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error Resume Next

Dim Metric As String

Metric = Target.Value

Select Case Metric

Case "Revenue"

Worksheets("Data").Range("F2").Value = Metric

Case "Gross Profit"

Worksheets("Data").Range("F2").Value = Metric

Case "Net Profit"

Worksheets("Data").Range("F2").Value = Metric

Case "Employees"

Worksheets("Data").Range("F2").Value = Metric

End Select

End Sub

Thursday, January 21, 2021

log in box in excel by vba

Private Sub CommandButton1_Click()

If TextBox1.Text = "apple" Or TextBox2.Text = "banana" Then

Application.Visible = True

Unload Me

Else

TextBox1 = ""

TextBox2 = ""

MsgBox "wrong details"

End If

End Sub

and show form

Private Sub Workbook_Open()

Application.Visible = False

UserForm1.Show

End Sub

Sunday, January 17, 2021

Automatic save file any location by vba

Sub SaveInvoiceWithNewName()

    Dim NewFN As Variant
    ' Copy Invoice to a New Workbook
    ActiveSheet.Copy
    NewFN = "FILEPATH\" & Range("i5").Value & ".xlsx"
    ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close
    NextInvoice
End Sub