Ravindra Bagale · Excelसर्व coursesया course चे lessonsशोधाEnglish

Excel · मराठी आवृत्ती

12.12 Practical macros — code वाचा, मग copyवर तपासा

रवींद्र बागले यांच्या course वर आधारित · सहज मराठीत explanation

या page मध्ये

खाली मूळ lessonचे पाच macros आहेत. काही examples cells overwrite करतात किंवा existing sheets delete करतात. ते production-ready utilities नाहीत; disposable practice workbookवरच तपासा. प्रत्येक sectionमध्ये सुधारण्याच्या अटी दिल्या आहेत.

A. Daily report formatting

Sub FormatDailyReport()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim rupeeFmt As String

    Set ws = ThisWorkbook.Worksheets("Orders")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    If lastRow < 2 Then
        MsgBox "No orders found.", vbExclamation
        Exit Sub
    End If

    ' Indian rupee format; ChrW(8377) is the rupee symbol
    rupeeFmt = "[>=10000000]" & ChrW(8377) & "##\,##\,##\,##0;" & _
               "[>=100000]" & ChrW(8377) & "##\,##\,##0;" & ChrW(8377) & "##,##0"

    Application.ScreenUpdating = False
    With ws.Range("A1:I1")
        .Font.Bold = True
        .Font.Color = RGB(255, 255, 255)
        .Interior.Color = RGB(33, 115, 70)
    End With
    ws.Range("B2:B" & lastRow).NumberFormat = "dd-mm-yyyy"
    ws.Range("G2:G" & lastRow).NumberFormat = rupeeFmt

    ' Highlight late deliveries (more than 15 minutes)
    With ws.Range("H2:H" & lastRow)
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="=15"
        .FormatConditions(1).Interior.Color = RGB(255, 199, 206)
    End With

    ws.Columns("A:I").AutoFit
    ws.Activate
    ActiveWindow.FreezePanes = False
    ws.Range("A2").Select
    ActiveWindow.FreezePanes = True
    Application.ScreenUpdating = True
    MsgBox "Daily report formatted: " & lastRow - 1 & " orders.", vbInformation
End Sub

Orders A:I, Date B, Amount G, Mins H असा schema अपेक्षित आहे. Header format, dates, rupee display, late-delivery conditional format, autofit आणि freeze panes करतो. FormatConditions.Deleteमुळे Hच्या existing rules जातात. Messageमधला count rowsचा आहे, distinct ordersचा नाही. Negative/decimal amountsवर custom rupee format स्वतंत्रपणे तपासा.

B. City spaces clean करा

Sub TrimCityColumn()
    Dim ws As Worksheet
    Dim cell As Range
    Dim lastRow As Long

    Set ws = ThisWorkbook.Worksheets("Orders")
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

    For Each cell In ws.Range("C2:C" & lastRow)
        If Not IsError(cell.Value) And Not cell.HasFormula Then
            If VarType(cell.Value) = vbString Then
                ' Replace non-breaking spaces, then Excel's TRIM (also removes double spaces inside)
                cell.Value = Application.WorksheetFunction.Trim(Replace(cell.Value, ChrW(160), " "))
            End If
        End If
    Next cell
End Sub

Formula आणि error cells skip करून textमध्ये NBSPला space आणि Excel TRIM वापरतो. VBA Trim फक्त टोकांचे spaces काढतो; WorksheetFunction.Trim मधले repeated spacesही कमी करतो. lastRow < 2 असेल तर Exit Sub guard loopच्या आधी जोडा; C2:C1सारखा अनपेक्षित range तयार होऊ देऊ नका.

C. Cityनुसार sheets — मूळ destructive example

Sub SplitByCity()
    Dim src As Worksheet, ws As Worksheet
    Dim cities As Object
    Dim lastRow As Long, lastCol As Long, r As Long
    Dim city As Variant
    Dim dataRng As Range

    Set src = ThisWorkbook.Worksheets("Orders")
    lastRow = src.Cells(src.Rows.Count, "A").End(xlUp).Row
    lastCol = src.Cells(1, src.Columns.Count).End(xlToLeft).Column
    Set dataRng = src.Range(src.Cells(1, 1), src.Cells(lastRow, lastCol))

    ' Collect distinct city names (column C) in a Dictionary
    Set cities = CreateObject("Scripting.Dictionary")
    For r = 2 To lastRow
        city = Trim(CStr(src.Cells(r, 3).Value))
        If Len(city) > 0 Then
            If Not cities.Exists(city) Then cities.Add city, 1
        End If
    Next r

    Application.ScreenUpdating = False
    If src.AutoFilterMode Then src.AutoFilterMode = False

    For Each city In cities.Keys
        ' Delete an old sheet of the same name, if any
        Application.DisplayAlerts = False
        On Error Resume Next
        ThisWorkbook.Worksheets(CStr(city)).Delete
        On Error GoTo 0
        Application.DisplayAlerts = True

        Set ws = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        ws.Name = CStr(city)

        dataRng.AutoFilter Field:=3, Criteria1:=CStr(city)
        dataRng.SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("A1")
        ws.Columns.AutoFit
    Next city

    src.AutoFilterMode = False
    src.Activate
    Application.ScreenUpdating = True
    MsgBox cities.Count & " city sheets created.", vbInformation
End Sub

हा source code त्याच City नावाची sheet alert न दाखवता delete करतो. Real workbookवर तसाच run करू नका. सुधारित utilityमध्ये जुनी sheet delete करण्याऐवजी नवीन unique output name द्या, किंवा स्वतंत्र output workbook वापरा. Source Orders sheet कधीही target नावाशी collide होऊ देऊ नका.

City column C, ordinary range, valid city values अशी assumptions आहेत. Dictionaryचा CreateObject platform support तपासा. City nameमध्ये /, :, [, ]सारखे invalid sheet characters किंवा 31पेक्षा जास्त characters असू शकतात; sanitize, truncate आणि uniqueness तपासा. Error-valued cities आणि wildcard filter charactersही हाताळा. Table असेल तर ListObject वापरून adapt करा.

D. सर्व sheetsची नावे

Sub ListAllSheets()
    Dim ws As Worksheet
    Dim i As Long
    For Each ws In ThisWorkbook.Worksheets
        i = i + 1
        Debug.Print i; ws.Name; " - used range "; ws.UsedRange.Address
    Next ws
End Sub

Immediateमध्ये sheet नाव आणि UsedRange दिसतो. UsedRangeमध्ये जुनं formattingही धरलं जाऊ शकतं; तो exact data count नाही.

E. City sheets combine — मूळ example

Sub CombineCitySheets()
    Dim ws As Worksheet, dest As Worksheet
    Dim lastRow As Long, lastCol As Long, destRow As Long

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets("Combined").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    Set dest = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Worksheets(1))
    dest.Name = "Combined"
    destRow = 1

    For Each ws In ThisWorkbook.Worksheets
        Select Case ws.Name
            Case "Combined", "Orders", "Stores", "Products", "Lists", "Report"
                ' skip non-city sheets
            Case Else
                lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
                If lastRow >= 2 Then
                    If destRow = 1 Then        ' copy the header once
                        ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol)).Copy dest.Cells(1, 1)
                        destRow = 2
                    End If
                    ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, lastCol)).Copy dest.Cells(destRow, 1)
                    destRow = destRow + (lastRow - 1)
                End If
        End Select
    Next ws

    dest.Columns.AutoFit
    Application.ScreenUpdating = True
    MsgBox "Combined " & (destRow - 2) & " rows into the Combined sheet.", vbInformation
End Sub

हा source code existing Combined sheet delete करतो आणि काही नावे वगळून बाकी सर्व sheets घेतो. Summary/notesची नवी sheetही चुकून combine होऊ शकते. Real utilityमध्ये explicit allowlist किंवा controlled generated-sheet list वापरा; header names/order match करा; जुनं output न पुसता नवीन destination तयार करा.

Blank City rows splitमधून वगळल्या जातात. म्हणून Combined = Orders check करण्याआधी valid-city source count आणि excluded-row count दोन्ही मोजा. Amount totalsही जुळवा. Zero inputसाठी row-count message negative होणार नाही अशी guard द्या.

Cleanup आणि practice

ScreenUpdating/DisplayAlertsची आधीची values capture करून success आणि error दोन्ही pathsमध्ये restore करा; पुढचा lesson पाहा. Copyवर Split/Combine तपासा, source आणि output counts/totals जुळवा. Platform splitसाठी Field 4 आणि पूर्ण validation बदलून वापरा.