examples

On this website you will find some typical examples from my VBA-tanker.

Example 1: How to consolidate sales per month and costcenter

Grouped data from “tbl_Data” –> “tbl_Matrix”
Sub FillData()
  Dim VarDat As Variant
  Dim VarTotal As Variant
  Dim lngRow As Long
  Dim lngRowMax As Long
  Dim lngZ As Long
  Dim lngCol As Long
 
  Application.Calculation = xlCalculationManual
  
  lngRowMax = tbl_Data.UsedRange.Rows.Count
  VarDat = tbl_Data.Range("A2:D" & lngRowMax)
  
  With tbl_Matrix
   .Range("Matrix").ClearContents
   VarTotal = .Range("A1:M41")
   For lngRow = 1 To UBound(VarDat, 1)
   
    For lngZ = 1 To UBound(VarTotal, 1)
     lngCol = VarDat(lngRow, 3) + 1
     If VarTotal(lngZ, 1) = VarDat(lngRow, 1) Then
      VarTotal(lngZ, lngCol) = VarTotal(lngZ, lngCol) + VarDat(lngRow, 4)
      Exit For
     End If
    
    Next lngZ
   
   Next lngRow
    
  .Range(.Cells(1, 1), .Cells(UBound(VarTotal, 1), UBound(VarTotal, 2))) = VarTotal
    
  End With

 Application.Calculation = xlCalculationAutomatic

End Sub
'VBA-Tanker: ID 1048
very fast solution

Buy the VBA tanker now to get 1 year free Updates!

Example 2: How to consolidate sales per month

Add new workbook and consolidate sales per month
Sub ConsolidateSalesPerMonth()
   Dim cn As Object
   Dim rs As Object
   Dim strConnection As String
   Dim strSQL As String
   Dim wkbTarget As Workbook
   Dim intZ As Integer
   Dim i As Integer

  Set cn = CreateObject("ADODB.CONNECTION")

   strConnection = _
   "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}; DBQ=" & _
   ThisWorkbook.FullName

   With cn

      .Open strConnection
    intZ = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 12
    Set wkbTarget = Workbooks.Add
    Application.SheetsInNewWorkbook = intZ
    
    For i = 1 To 12
    wkbTarget.Worksheets(i).Columns(1).NumberFormat = "DD.MM.YYYY"
   
     strSQL = tbl_month.TextBoxes(1).Text & i
     

     Set rs = CreateObject("ADODB.RECORDSET")
     With rs
      .Source = strSQL
      .ActiveConnection = strConnection
      .Open
      wkbTarget.Worksheets(i).Range("A1").CopyFromRecordset rs
      wkbTarget.Worksheets(i).Range("D1").Value = _
      Application.WorksheetFunction.Sum(wkbTarget.Worksheets(i).Columns(2))
      .Close
     End With
     
    Next i
    
   End With


   cn.Close

   Set cn = Nothing
   Set rs = Nothing

End Sub
'VBA-Tanker: ID 1043
12 monthly sheets in a new workbook with one total sum in cell D1

Buy the VBA tanker now to get free e-mail hotline!

Example 3: How to program a progressBar with percentage of rest runtime of macro

for macros with a longer runtime…
Private Sub UserForm_Activate()
      Dim lngRowMax As Long
      Dim lngRow As Long
      Dim lngProg As Long
      Dim dblFakt As Double

10       On Error GoTo UserForm_Activate_Error

20    Application.Calculation = xlCalculationManual
30    With Sheet1
40    lngRowMax = .UsedRange.Rows.Count
50    lngproz = 200
60    dblFakt = lngRowMax / lngproz
70    Me.ProgressBar1.Max = lngRowMax

80    For lngRow = 2 To lngRowMax
90      If .Range("A" & lngRow).Value >= 80 Then
100        .Range("A" & lngRow).Interior.ColorIndex = 4
110        .Range("B" & lngRow).Value = .Range("A" & lngRow).Value * 1.1
120     End If
130     If lngRow Mod 10000 = 0 Then
140     Me.Label1.Caption = Format(lngRow / lngRowMax, "0.00 %")
150     Me.Label3.Caption = "row " & lngRow & " / " & lngRowMax
160     DoEvents
165
170     End If
180     Me.ProgressBar1.Value = lngRow
190   Next lngRow
200   End With
210   Application.Calculation = xlCalculationAutomatic
220   Unload Me

230      On Error GoTo 0
240      Exit Sub

UserForm_Activate_Error:

250     MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure UserForm_Activate of Formular UserForm1_" & Erl
260     Application.Calculation = xlCalculationAutomatic
End Sub
'VBA-Tanker, ID 1029

Buy the VBA tanker now to learn new techniques!

Example 4: How to insert a PDF as object in a sheet

Sub InsertPDFasIcon()
  Dim objFileDialog As Office.FileDialog
  Dim VarFile As Variant
   
  Set objFileDialog = Application.FileDialog(MsoFileDialogType.msoFileDialogFilePicker)
   
  With objFileDialog
     .ButtonName = "Insert PDF"
     .Title = "Link to pdf"
     .InitialView = msoFileDialogViewList
     .Show
     
     If .SelectedItems.Count = 1 Then
        VarFile = (.SelectedItems(1))
        
        With Tabelle1
          .OLEObjects.Add Filename:=VarFile, Link:=False, DisplayAsIcon:=False, _
           Left:=40, Top:=40, Width:=150, Height:=10
        End With
     
     End If
     
  End With

End Sub
'VBA-Tanker, ID 1022

Buy the VBA tanker now to benefit from 25 years of vba experience!

Example 5: How to find formatted value in a Column

Find the bold value 95
Sub FindValueandFormat()
 Dim rngHit As Range
 
 With Sheet1
   Application.FindFormat.Font.Bold = True
   
   Set rngHit = .Range("B:B").Find(what:=.Range("F1").Value, lookat:=xlWhole, _
                                   SearchFormat:=true)
   
   If Not rngHit Is Nothing Then
    .Range("G1").Value = rngHit.Offset(0, -1).Value
    Else
    .Range("G1").ClearContents
   End If
   
   Application.FindFormat.Clear
 End With
 
End Sub
'VBA-Tanker, ID 1005

Buy the VBA tanker now to save own macros in vba tanker!