On this website you will find some typical examples from my VBA-tanker.
![](https://vba-tanker.com/wp-content/uploads/2019/05/VBA-Tanker03.jpg)
Example 1: How to consolidate sales per month and costcenter
![](https://vba-tanker.com/wp-content/uploads/2019/05/pic1.jpg)
![](https://vba-tanker.com/wp-content/uploads/2019/05/pic2.jpg)
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
![](https://vba-tanker.com/wp-content/uploads/2019/05/pic3.jpg)
Buy the VBA tanker now to get 1 year free Updates!
Example 2: How to consolidate sales per month
![](https://vba-tanker.com/wp-content/uploads/2019/05/pic4.jpg)
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
![](https://vba-tanker.com/wp-content/uploads/2019/05/pic5.jpg)
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
![](https://vba-tanker.com/wp-content/uploads/2019/05/pic6.jpg)
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
![](https://vba-tanker.com/wp-content/uploads/2019/05/pic7-1.jpg)
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
![](https://vba-tanker.com/wp-content/uploads/2019/05/pic8-1.jpg)
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
![](https://vba-tanker.com/wp-content/uploads/2019/05/pic9-1.jpg)