Showing posts with label Excel Macros. Show all posts
Showing posts with label Excel Macros. Show all posts

Wednesday, 29 March 2023

Macro to unprotect multiple workbooks in a Folder

Object of the Macro:


Multiple excel workbooks are in a folder.

Each workbook is protected by a password.

I want to get them unprotected using a the password and get them pooled into a folder.


Code:

 

 

Sub Hell3()

    Dim WB As Workbook

    Dim xFd As FileDialog

    Dim xFdItem As Variant

    Dim xFileName As String

    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

 

    If xFd.Show = -1 Then

        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator

        xFileName = Dir(xFdItem & "*.xls*")

        MkDir xFdItem & "\Password Removed Files"

        Do While xFileName <> ""

            Set WB = Workbooks.Open((xFdItem & xFileName), Password:="pass")

 

                WB.SaveAs Filename:=xFdItem & "Password Removed Files\" & xFileName, FileFormat:=51, Password:="", WriteResPassword:="", _

                ReadOnlyRecommended:=False, CreateBackup:=False

 

                WB.Close True

             xFileName = Dir

        Loop

    End If

 End Sub


Note: 


Ensure to replace the word "pass" with your actual password in the code

 

 

Wednesday, 21 December 2022

Macro to compare two data sets

 1. Object of the macro


a)The data is populated as follows:




b) I want to compare based on the Unique identifier List A and List B

c) Highlight the common items in List A and List B

d) Get populated in Sheet 2, items present in List A, but not in List B

e)Get populated in Sheet 3, items present in List B, but not in List A



2. Code

Sub Comparedatasets()

Application.ScreenUpdating = False

lr1 = Range("A" & Rows.Count).End(xlUp).Row

lr2 = Range("D" & Rows.Count).End(xlUp).Row

Sheets(1).Range("A2", "B2").Copy

Sheets(2).Range("A1").PasteSpecial Paste:=xlPasteValues

Sheets(3).Range("A1").PasteSpecial Paste:=xlPasteValues

check = False

For r = 3 To lr1

Set compare1 = Cells(r, 1)

For q = 3 To lr2

Set Compare2 = Cells(q, 4)

If compare1 = Compare2 Then Compare2.Interior.Color = vbYellow: check = True

Next q

If check = False Then

Range(compare1, compare1.End(xlToRight)).Copy

Sheets(3).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _Paste:=xlPasteValues

End If

check = False

Next r  

check = False

For r = 3 To lr2

Set compare1 = Cells(r, 4)

For q = 3 To lr1

Set Compare2 = Cells(q, 1)

If compare1 = Compare2 Then Compare2.Interior.Color = vbYellow: check = True

Next q 

If check = False Then

Range(compare1, compare1.End(xlToRight)).Copy

Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _Paste:=xlPasteValues

End If

check = False      

Next r

Application.ScreenUpdating = True

End Sub



3) Result  



 






Wednesday, 14 December 2022

Diaries on VBA- Scripting Dictionary

 

1. Part 1- Basics of Dictionary


a) Dictionary is used to assign a value to a key/item

b)Syntax

i) If I want to create Gowtham as new dictionary

Dim Gowtham as Newdictionary

ii) Add items to the dictionary Gowtham

For Eg. I want to assign 1 to a, 2 to b


gowtham. add(a,1)

gowtham. add(a,2)


c) When a key is not already declared and is called later, it will get created in dictionary

For Eg,



Sub usedictionary()


Dim dict As New Dictionary


dict.Add "a", 1

dict.Add "b", 2

dict.Add "c", 3

dict("d") = dict("d") + 100


Debug.Print dict("d")

 

End Sub


..., the above code will print 100 

Tuesday, 6 December 2022

Macro to count the number of characters in cells and populate the data set sperately

  1. Object of  the Macro



I want to:

  • count the number of HSN digits in Column A, 
  • get them populated in Column C, 
  • filter the items with HSN less than 6 digits and
  • get the dataset pasted at the cell H1.



2. The Code


Sub countcharactersincell()

Dim a As String

Dim b As Integer

Dim i As Integer

Dim j As Integer

Dim k As Integer

j = Cells.End(xlDown).Row

For i = 2 To j

a = Cells(i, 1) 

b = Len(a)

Cells(i, 3) = b

Next i

Range("A1").AutoFilter Field:=3, Criteria1:="<6"

Range("a1:c" & Range("a1").End(xlDown).Row).SpecialCells(xlCellTypeVisible).Copy

Cells(1, 8).PasteSpecial

End Sub


3. Output 




Funfact:

The same output could be achieved with a simple "Sorting" option of Excel. 

But, I'm crazy about those "Mootai poochiyai kollum navina machine"

 

Thursday, 6 January 2022

MS Excel- Formula to embed accounting/currency format inside a string

1.)  "&TEXT(Reference cell," #,##0 ;")

="Type the characters you want"&TEXT(A1," #,##0 ;")


How to use it:

Say, A1 cell has got a formula and it computes and gives me the output of an amount in simple numerics, say, 154358.

Now, I want to be presented in Rs.

Here is how I will use the formula

="Rs."&TEXT(A1," #,##0 ;")

Output

Rs. 1,54,358


2) Sometimes, the numbers don't get populated in accounting format i.e. -100000 as (100,000)


a) For that, go to the format cells (Ctrl + 1)

b) In the custom format, paste the following string in the input box

_ * #,##0.00_ ;_ * (#,##0.00)_ ;_ * "-"??_ ;_ @_ 

c) And click Ok

Friday, 31 December 2021

Macro to convert the reference from relative to absolute for a selected range of cell

Note: Before you run this macro, ensure you have selected the cells, whose reference you want to convert


Sub Relative_to_Absolute()

Dim fmlaCells As Range

On Error Resume Next

Set fmlaCells = Selection

fmlaCells.Formula = Application.ConvertFormula _

(fmlaCells.Formula, xlA1, xlA1, xlAbsolute)

End Sub


 

Wednesday, 29 December 2021

Macro to trace dependents for a range of cells

 Sub TraceDependents()


'updateby Extendoffice

    Dim xRg As Range

    Dim xCell As Range

    Dim xTxt As String

    On Error Resume Next

    xTxt = ActiveWindow.RangeSelection.Address

    Set xRg = Application.InputBox("Please select the data range:", xTxt, , , , , 8)

        If xRg Is Nothing Then Exit Sub

    For Each xCell In xRg

        xCell.ShowDependents

    Next

End Sub



Source: https://www.extendoffice.com/documents/excel/3402-excel-trace-dependents-multiple-cells.html

Monday, 13 September 2021

Macro to consolidate data from multiple worksheets

When data are spread across multiple worksheets and one wanna put together everything in a  single sheet of the workbook, the following macro works.

Tuesday, 31 March 2020

Macro to Crack the Password of a Protected Sheet

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
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)
Exit Sub
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
End Sub

Credit: http://www.excelsupersite.com/how-to-unprotect-an-excel-spreadsheet-if-you-have-lost-your-password/ 

Thursday, 22 February 2018

VBA in Excel - Properties, Methods and Events - 2



1.

Selection.SpecialCells(xlCellTypeBlanks).Select

This statement selects the blank special cells of the original selection. (The word SpecialCells is a method that handles many of the options in the Go To Special dialog box.)


2. 

Selection.FormulaR1C1 = "=R[-1]C"

This statement assigns =R[-1]C as the formula for the entire selection. When you entered the formula, the formula you saw was =C2, not =R[-1]C. The formula =C2 really means "get the value from the cell just above me," but only if the active cell happens to be cell C3. The formula =R[-1]C also means "get the value from the cell just above me," but without regard for which cell is active.
You could change this statement to Selection.Formula = "=C2" and the macro would work exactly the same—provided that the order file you use when you run the macro is identical to the order file you used when you recorded the macro and that the active cell happens to be cell C3 when the macro runs. However, if the command that selects blanks produces a different active cell, the revised macro will fail. The macro recorder uses R1C1 notation so that your macro will always work correctly.


3. 

Selection.CurrentRegion.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select

These statements select the current region, convert the formulas to values, cancel copy mode, and select cell A1.


4.


Sub AddDates()
    Range("A1").Select
    Selection.EntireColumn.Insert
    ActiveCell.FormulaR1C1 = "Date"
    Range("A2").Select
    Selection.CurrentRegion.Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "Nov-2007"
    Range("A1").Select
End Sub


This macro is pretty straightforward. Notice that the statement that enters the word Date uses the word ActiveCell as the object, changing the "formula" of only the active cell, whereas the statement that enters the actual date uses the word Selection as the object, changing the "formula" of the entire range of selected cells. When you enter a formula using the Enter key alone, the macro uses the word ActiveCell. When you enter a formula using Ctrl+Enter, the macro uses the word Selection. (If the selection consists of only a single cell, ActiveCell and Selection are equivalent.)
In addition, using just the Enter key changes the selection to the next cell down. That's why the Range("A2").Select statement is in the macro. It doesn't hurt anything, but it is also unnecessary. Removing unnecessary statements from a recorded macro makes it easier to read, and easier to modify in the future if you ever need to.


5. 

Selection.End(xlDown).Select
This statement is equivalent to pressing Ctrl+Down Arrow. It starts with the active cell, searches down to the last nonblank cell, and selects that cell.


6.
 Workbooks.Open Filename:="C:\MSP\ExcelVBA07SBS\Orders.xlsx"



In the Visual Basic editor window, the statement that opens the master list should be highlighted:
Workbooks.Open Filename:="C:\MSP\ExcelVBA07SBS\Orders.xlsx"
This statement opens the master list workbook.
TIP
If you remove the path from the file name, leaving only the actual file, the macro looks for the file in the current folder. That would be useful if you move the project to a new folder. However, if the master list is always in the same location, but the source file may be in different locations, it is better to leave the full path of the master file.


7.


ActiveWorkbook.Close SaveChanges:=False
The SaveChanges argument answers the dialog box's question before it even gets asked. While testing, you can have the macro not save the workbook. Once you're ready to really use the macro, you can change the argument to True.

8.


ActiveWindow.SelectedSheets.Delete
The statement refers to the "selected sheets of the active window" because it's possible to select and delete multiple sheets at the same time. (Press and hold the Ctrl key as you click several sheet tabs to see how you can select multiple sheets. Then click an unselected sheet without using the Ctrl key to deselect the sheets.) Because you're deleting only one sheet, you could change the statement to ActiveSheet.Delete if you wanted, but that isn't necessary.


9.


Application.DisplayAlerts = False

DisplayAlerts is a property of the Excel application. When you set the value of this property to False, any confirmation prompts that you would normally see are treated as if you had selected the default answer. The DisplayAlerts setting lasts only until the macro finishes running, so you don't need to set it back to True. You do, however, need to be careful to never run this macro when the active sheet is something you care about. Naturally, you should also be careful to save your work often and keep backup copies.


(From the book

Microsoft® Office Excel® 2007 Visual Basic® for Applications Step by Step 

by Reed Jacobson)

Wednesday, 21 February 2018

VBA in Excel - Properties, Methods and Events - 1


       One of the best way to learn programing is to learn from the already written codes. As I start to learn VBA for Excel, I feel it extremely difficult to put together the arguments and form a clear knowledge base. The exercise of putting together the  myriad arguments and syntax for programming appears like solving a jigsaw  puzzle.

    In this Excel VBA series, I will posting my learnings of the commonly used properties, methods and events.

   Thanks to my gurus Professor Charlie Nuttelman of  University of collorado and Lokesh Jayasankar sir of BNP Paribas for being of kind guidance in helping me to learn.

    These are basically sample codings. Explanation is appended to codings wherever I felt they are necessary.

1)   msgbox range("d22")


2)   Range("a3:aa5000").AutoFilter Field:=5, Criteria1:="OS-sal"

3)   range("G:G").select

4)   sales = WorksheetFunction.Sum(Range("J:J"))


Range("a1") = sales


5) Displays the color index for the color in the cell


   msgbox range("A1").interior.colorindex

6)   Application.workbooks("Project6).Worksheets("Main").Range(B16")


7)   range("a3").offset(1000,1000)



8)   Copy data from one worksheet and paste into another worksheet


Worksheets("Commands").Range("A1").copy

Worksheets("Feuil3").select

Range("A1").select

Activesheet.paste


9)


Sub Example9( )
Dim DIV as double

Sheet1.Select

ActiveSheet.Range("A8:S60000").autofilter field:=5, Criteria1:="DIV"

With wksT.autofilter.Range

Range("J" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select

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

DIV = Application.WorksheetFunction.Sum(Selection)

End With

Range("P8:P" & Cells(Rows.Count, "B").End(xlUp).Row)

End sub

10)  msgbox(" the square is "&y&" only.")

11)  msgbox(" the square is "& formatnumber(y,2)&" only.")

12)  Get the value in active cell


Activecell = formatnumber (y,2)


13)   Get the value from cell A1 and output the value to cell C3


Input


x = range("a1")


Output


range("c3")=formatnumber(y,2)


14)  Msgbox range("b2:d3").count * activecell + cells(5,2)* inputbox("Please enter a number:")

15)  set w1=worksheets("sheet1)


16)  Pick a cell from existing selection

Selection. Cells(2,2)


17)  Count the number of rows and columns in a selection

nr= selection.rows.count

nc=selection.columns.count


18)  x = inputbox()


19)Get a value of 5 into a cell some rows/columns from activecells


  activecell.offset(2,2) = 5


20)  sub example20()

dim x ,y ,z

x=inputbox()

y=activecell

z= x+y

activecell.offset(2,2) = z

End sub






Saturday, 9 January 2016

Macro to copy the sum of selected cells on selection


Object of the Macro : To get copied to the clipboard, the sum of the cells selected in a worksheet so that it can pasted directly without having to sum the numbers in the cell, copy the sum and then paste.

Macro:  

Sub CopySum()
Dim xOb As New DataObject
xOb.Clear
xOb.SetText Application.WorksheetFunction.Sum(Application.ActiveWindow.RangeSelection)
xOb.PutInClipboard
End Sub


If the macro throws a compile error that the "User-defined type not defined", here's the way-out


Open References in Word VBA

Click on Browse

Pick up this file and click Open

C:\WINDOWS\SYSTEM\FM20.DLL 


Courtesyhttps://answers.microsoft.com/en-us/msoffice/forum/all/mystery-compile-error-user-defined-type-not/b0c07a65-9f0c-43f1-a181-12c95db0ac8d