لرن سرا

برچسب: VBA

  • VBA – A* Search Algorithm with Excel – Useful code


    Ok, so some 10 years ago, I was having fun coding A* Search Algorithms in Excel in VitoshAcademy and this is what I had built back then:

    VBA – A* search algorithm with Excel – Really?

    VBA – A Search Algorithm with VBA – Teil Zwei

    The second one is actually quite fun and I had forgotten about it. Today, I will present a third one, that has a few more features, namely the following:

    • It can be copied completely into a blank Excel’s VBA module, without any additional setup and it will work
    • You can choose for distance method (Manhattan or Heuristics)
    • You can choose for displaying or not calculations in Excel (
      writeScores = False )
    • You can
      ResetAndKeep() , which cleans out the maze, but keeps the obstacles
    • You can setup your own start and goal cell. By simply writing
      s and
      g , somewhere in the PLAYGROUND.
    • You can change the speed of writing in the Excel file, by changing the
      delay variable.

    These are the current commands:



    Source link

  • VBA – Automated Pivot Filtering – Useful code


    Sub FilterPivotTableBasedOnSelectedTeams()

     

        Dim pt As PivotTable

        Dim selectedItemsRange As Range

        Dim myCell As Range

        Dim fieldName As String

        Dim lastRowSelected As Long

        Dim pi As PivotItem

        Dim firstItemSet As Boolean

     

        Set pt = ThisWorkbook.Worksheets(“PivotTable2”).PivotTables(“PivotTable2”)

        lastRowSelected = LastRow(tblTemp.Name, 1)

        Set selectedItemsRange = tblTemp.Range(“A1:A” & lastRowSelected)

        fieldName = “Team”

        pt.PivotFields(fieldName).ClearAllFilters

        

        Dim itemsTotal As Long

        itemsTotal = pt.PivotFields(fieldName).PivotItems.Count

        

        For Each pi In pt.PivotFields(fieldName).PivotItems

            If Not IsInRange(pi.Name, selectedItemsRange) Then

                itemsTotal = itemsTotal – 1

                If itemsTotal = 0 Then

                    Err.Raise 222, Description:=“No value in the pivot!”

                    Exit Sub

                End If

                

                pi.Visible = False

            End If

        Next pi

     

    End Sub

     

    Function IsInRange(myValue As String, myRange As Range) As Boolean

        

        Dim myCell As Range

        IsInRange = False

        For Each myCell In myRange.Cells

            If myCell.value = myValue Then

                IsInRange = True

                Exit Function

            End If

        Next myCell

     

    End Function

     

    Public Function LastRow(wsName As String, Optional columnToCheck As Long = 1) As Long

     

        Dim ws As Worksheet

        Set ws = ThisWorkbook.Worksheets(wsName)

        LastRow = ws.Cells(ws.Rows.Count, columnToCheck).End(xlUp).Row

     

    End Function



    Source link