Thread: Building Excel Macro for counting interations and cell value

Hello Josh,

Where will these incremented values be placed?

Hi joshjpang;

These macros will put into A1 "Customer 1, Division 1" .. "Customer 20, Division 30".
Cell A2 must have 20 in it and Cell A3 must have 30 in it.

They will create buttons for you.

On the sheet
1) Right Mouse Click sheet tab and select "View Code". This will open a window with a name at the top like this :"myWorkbook.xls - Sheet1 (Code)"
2) Cut & Paste All this Code into that window.
3) Click Alt+F11. This will take you back to Excel
4) Put your cursor where you want the buttons. It will create 2 buttons that take up 5 cells down. Example: Cursor in C5, Button 1 will be in C5:C6 and Button 2 will be in C8:C9. Button 1 will say "Increment Customer", and Button 2 will say "Increment Division"

5) Click Alt+F8. This will open the macro window.
6) Select "Create_Buttons" and click "Run". If there is more than one macro in the list, select "This Workbook" in "Macros In:"

To change text, Right Mouse click the button and select "Edit Text".
To change size, Right Mouse click the button and grab one of the circles with the Left Mouse button and drag.
To move, Right Mouse click the button and grab shaded border with the Left Mouse button and drag.

Public Sub Increment_Customer(Optional sScratch As String)
    Dim sh As Worksheet
    Dim s As String
    Dim i As Integer
    Dim iNew As Integer
    Dim iInStr As Integer
    Dim sCust As String

    Set sh = ActiveSheet
    sCust = "Customer "

    With sh.Range("A1")
        s = .Value
        iInStr = InStr(s, sCust)
        If iInStr = 0 Then
            s = "Customer 1, Division 1"
            iInStr = InStr(s, sCust)
        End If

        i = Val(Mid(s, iInStr + Len(sCust)))
        If i = .Range("A2").Value Then
            iNew = 1
        Else
            iNew = i + 1
        End If
        .Value = Replace(s, sCust & i, sCust & iNew)
        .EntireColumn.AutoFit
    End With
End Sub

Public Sub Increment_Division(Optional sScratch As String)
    Dim sh As Worksheet
    Dim s As String
    Dim i As Integer
    Dim iNew As Integer
    Dim sDiv As String
    Dim iInStr As Integer

    Set sh = ActiveSheet
    sDiv = " Division "

    With sh.Range("A1")
        s = .Value
        iInStr = InStr(s, sDiv)
        If iInStr = 0 Then
            s = "Customer 1, Division 1"
            iInStr = InStr(s, sDiv)
        End If

        i = Val(Mid(s, iInStr + Len(sDiv)))
        If i = .Range("A3").Value Then
            iNew = 1
        Else
            iNew = i + 1
        End If
        .Value = Replace(s, sDiv & i, sDiv & iNew)
        .EntireColumn.AutoFit
    End With
End Sub

Sub Create_Buttons()
    Dim dL As Double
    Dim dT As Double
    Dim dW As Double
    Dim dH As Double
    Dim oButton As Object
    Dim r As Range
    Dim iButton As Integer
    Dim sCaption As String
    Dim sh As Worksheet
    
    Set sh = ActiveSheet
    Set r = Selection
    sCaption = "Increment_Customer"
    For iButton = 1 To 2
        With r.Resize(2, 1)
            dL = .Left
            dT = .Top
            dW = .Width
            dH = .Height
        End With
        Set oButton = ActiveSheet.Buttons.Add(dL, dT, dW, dH)
        With oButton
            .Placement = xlMoveAndSize
            .OnAction = sh.CodeName & "." & sCaption
            .Caption = Replace(sCaption, "_", " ")
        End With
        sCaption = "Increment_Division"
        Set r = r.Offset(3, 0)
    Next iButton
End Sub