Monthly Archives: February 2025

Export Range to HTML file

10/02/2025Excel VBAadmin

With the code below you can export values or formulas from a worksheet range to a HTML-file:

Option Explicit

Sub this_starts_the_example()
    ' Adjust the range and the file location
    ExportRangeAsHTML Range("A1:F20"), "C:\temp\textfile.html", "", True, 1, 5, 0, True
End Sub

Sub ExportRangeAsHTML(SourceRange As Range, TargetFile As String, _
    TableSize As String, UseRangeColumnWidths As Boolean, _
    TableBorderSize As Integer, CellPadding As Integer, _
    CellSpacing As Integer, IncludeEmptyCells As Boolean)
    
    ' Exports the data in SourceRange to the textfile TargetFile in HTML format
    ' Adjust to your needs
    ' Example:     ExportRangeAsHTML Range("A1:F20"), "C:\temp\textfile.html", "", True, 1, 5, 0, True
    
    Dim A           As Integer, r As Long, c As Integer, totr As Long, pror As Long
    Dim fn          As Integer, LineString As String, tLine As String, CellColumnWidth As Long
    Dim BoldCell    As Boolean, ItalicCell As Boolean, CellAlignment As Integer
    
    ' validate the input data if necessary
    If SourceRange Is Nothing Then Exit Sub
    If Len(TargetFile) = 0 Then Exit Sub
    If Application.WorksheetFunction.CountA(SourceRange) = 0 Then
        If Not IncludeEmptyCells Then Exit Sub
    End If
    
    On Error Resume Next
    Kill TargetFile
    On Error GoTo 0
    If Len(Dir(TargetFile)) > 0 Then
        MsgBox TargetFile & " already exists, rename, move Or delete the file before you try again.", vbInformation, "Export range To textfile"
        Exit Sub
    End If
    
    ' perform export
    On Error GoTo NotAbleToExport
    fn = FreeFile
    Open TargetFile For Append As #fn        ' open textfile for new input
    On Error GoTo 0
    
    ' determine the total number of rows to process
    totr = 0
    For A = 1 To SourceRange.Areas.Count
        totr = totr + SourceRange.Areas(A).Rows.Count
    Next A
    
    ' start the HTML file
    Print #fn, "<html>"
    Print #fn, "<head>"
    Print #fn, "<meta name=""DESCRIPTION"" content=""Description of content"">"
    Print #fn, "<meta name=""KEYWORDS"" content=""Keywords"">"
    Print #fn, "<title>Range To HTML from " & ActiveWorkbook.Name & "</title>"
    Print #fn, "</head>"
    Print #fn,
    Print #fn, "<body>"
    Print #fn, "<h1>Range To HTML from " & ActiveWorkbook.Name & "</h1>"
    Print #fn,
    If TableSize = "" Then
        Print #fn, "<table border=""" & TableBorderSize & """ cellpadding=""" & CellPadding & """ cellspacing=""" & CellSpacing & """>"
    Else
        Print #fn, "<table border=""" & TableBorderSize & """ cellpadding=""" & CellPadding & """ cellspacing=""" & CellSpacing & """ width=""" & TableSize & """>"
    End If
    
    ' start writing the HTML-file
    pror = 0
    For A = 1 To SourceRange.Areas.Count
        For r = 1 To SourceRange.Areas(A).Rows.Count
            If pror Mod 50 = 0 Then
                Application.StatusBar = "Writing the HTML-file " & Format(pror / totr, "0 %") & "..."
            End If
            Print #fn, "  <tr>"
            For c = 1 To SourceRange.Areas(A).Columns.Count
                LineString = "    "
                CellAlignment = 0
                tLine = ""
                On Error Resume Next
                With SourceRange.Areas(A).Cells(r, c)
                    tLine = Trim(.Text)
                    BoldCell = .Font.Bold
                    ItalicCell = .Font.Italic
                    CellAlignment = .HorizontalAlignment
                End With
                On Error GoTo 0
                If (tLine = "" Or tLine = " ") And IncludeEmptyCells Then tLine = " "
                If tLine <> "" Then
                    LineString = LineString & "<td"
                    If UseRangeColumnWidths Then
                        CellColumnWidth = CLng(Cells(1, c + 1).Left - Cells(1, c).Left)
                        LineString = LineString & " width=""" & CellColumnWidth & """"
                    End If
                    If CellAlignment = xlHAlignGeneral Then
                        Select Case Asc(tLine)
                            Case 45, 48 To 57
                                CellAlignment = xlHAlignRight
                        End Select
                    End If
                    If CellAlignment = xlHAlignCenter Then LineString = LineString & " align=""center"""
                    If CellAlignment = xlHAlignRight Then LineString = LineString & " align=""right"""
                    LineString = LineString & ">"
                    If BoldCell Then LineString = LineString & "<b>"
                    If ItalicCell Then LineString = LineString & "<i>"
                    LineString = LineString & tLine
                    If ItalicCell Then LineString = LineString & "</i>"
                    If BoldCell Then LineString = LineString & "</b>"
                    LineString = LineString & "</td>"
                    Print #fn, LineString
                End If
            Next c
            Print #fn, "  </tr>"
            pror = pror + 1
        Next r
    Next A
    
    ' end the HTML file
    Print #fn, "</table>"
    Print #fn,
    Print #fn, "</body>"
    Print #fn, "</html>"
    Close #fn        ' close the targetfile
NotAbleToExport:
    Set SourceRange = Nothing
    Application.StatusBar = False
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

Option Explicit

Sub this_starts_the_example()

' Adjust the range and the file location

ExportRangeAsHTML Range("A1:F20"), "C:\temp\textfile.html", "", True, 1, 5, 0, True

End Sub

Sub ExportRangeAsHTML(SourceRange As Range, TargetFile As String, _

TableSize As String, UseRangeColumnWidths As Boolean, _

TableBorderSize As Integer, CellPadding As Integer, _

CellSpacing As Integer, IncludeEmptyCells As Boolean)

' Exports the data in SourceRange to the textfile TargetFile in HTML format

' Adjust to your needs

' Example: ExportRangeAsHTML Range("A1:F20"), "C:\temp\textfile.html", "", True, 1, 5, 0, True

Dim A As Integer, r As Long, c As Integer, totr As Long, pror As Long

Dim fn As Integer, LineString As String, tLine As String, CellColumnWidth As Long

Dim BoldCell As Boolean, ItalicCell As Boolean, CellAlignment As Integer

' validate the input data if necessary

If SourceRange Is Nothing Then Exit Sub

If Len(TargetFile) = 0 Then Exit Sub

If Application.WorksheetFunction.CountA(SourceRange) = 0 Then

If Not IncludeEmptyCells Then Exit Sub

End If

On Error Resume Next

Kill TargetFile

On Error GoTo 0

If Len(Dir(TargetFile)) > 0 Then

MsgBox TargetFile & " already exists, rename, move Or delete the file before you try again.", vbInformation, "Export range To textfile"

Exit Sub

End If

' perform export

On Error GoTo NotAbleToExport

fn = FreeFile

Open TargetFile For Append As #fn ' open textfile for new input

On Error GoTo 0

' determine the total number of rows to process

totr = 0

For A = 1 To SourceRange.Areas.Count

totr = totr + SourceRange.Areas(A).Rows.Count

Next A

' start the HTML file

Print #fn, "<html>"

Print #fn, "<head>"

Print #fn, "<meta name=""DESCRIPTION"" content=""Description of content"">"

Print #fn, "<meta name=""KEYWORDS"" content=""Keywords"">"

Print #fn, "<title>Range To HTML from " & ActiveWorkbook.Name & "</title>"

Print #fn, "</head>"

Print #fn,

Print #fn, "<body>"

Print #fn, "<h1>Range To HTML from " & ActiveWorkbook.Name & "</h1>"

Print #fn,

If TableSize = "" Then

Print #fn, "<table border=""" & TableBorderSize & """ cellpadding=""" & CellPadding & """ cellspacing=""" & CellSpacing & """>"

Else

Print #fn, "<table border=""" & TableBorderSize & """ cellpadding=""" & CellPadding & """ cellspacing=""" & CellSpacing & """ width=""" & TableSize & """>"

End If

' start writing the HTML-file

pror = 0

For A = 1 To SourceRange.Areas.Count

For r = 1 To SourceRange.Areas(A).Rows.Count

If pror Mod 50 = 0 Then

Application.StatusBar = "Writing the HTML-file " & Format(pror / totr, "0 %") & "..."

End If

Print #fn, " <tr>"

For c = 1 To SourceRange.Areas(A).Columns.Count

LineString = " "

CellAlignment = 0

tLine = ""

On Error Resume Next

With SourceRange.Areas(A).Cells(r, c)

tLine = Trim(.Text)

BoldCell = .Font.Bold

ItalicCell = .Font.Italic

CellAlignment = .HorizontalAlignment

End With

On Error GoTo 0

If (tLine = "" Or tLine = " ") And IncludeEmptyCells Then tLine = " "

If tLine <> "" Then

LineString = LineString & "<td"

If UseRangeColumnWidths Then

CellColumnWidth = CLng(Cells(1, c + 1).Left - Cells(1, c).Left)

LineString = LineString & " width=""" & CellColumnWidth & """"

End If

If CellAlignment = xlHAlignGeneral Then

Select Case Asc(tLine)

Case 45, 48 To 57

CellAlignment = xlHAlignRight

End Select

End If

If CellAlignment = xlHAlignCenter Then LineString = LineString & " align=""center"""

If CellAlignment = xlHAlignRight Then LineString = LineString & " align=""right"""

LineString = LineString & ">"

If BoldCell Then LineString = LineString & "<b>"

If ItalicCell Then LineString = LineString & "<i>"

LineString = LineString & tLine

If ItalicCell Then LineString = LineString & "</i>"

If BoldCell Then LineString = LineString & "</b>"

LineString = LineString & "</td>"

Print #fn, LineString

End If

Next c

Print #fn, " </tr>"

pror = pror + 1

Next r

Next A

' end the HTML file

Print #fn, "</table>"

Print #fn,

Print #fn, "</body>"

Print #fn, "</html>"

Close #fn ' close the targetfile

NotAbleToExport:

Set SourceRange = Nothing

Application.StatusBar = False

End Sub

Example of a worksheet range with random data.

Result, the basic HTML table.

Totalen van verkoper berekenen

10/02/2025Excel formulaadmin

Simpel voorbeeld.
Totalen berekenen van diverse verkopers. In dit voorbeeld: John, Jams, Super en Band. Beetje gekke namen maar dat boeit verder niet.
Formule komt in C11.

=SOMPRODUCT((($A$2:$A$7=A11)+($A$2:$A$7=B11));$C$2:$C$7)

Naar beneden kopiëren. Klaar

SOMPRODUCT met criterium

10/02/2025Excel formulaadmin

Je hebt een aantal artikelen die besteld worden door verschillende winkeliers. Je wil weten hoeveel de verkoop van 1 bepaald produkt heeft opgebracht. In dit voorbeeld: Tofu.

Formule in E4;

=SOMPRODUCT(–(A2:A23=E2);B2:B23:C2:C23)

Deze formule vermenigvuldigt kolom A met kolom B met kolom C en het resultaat optelt.

In feite krijg je dus:

Rij 5: 1 * € 18,60 * 9 = € 167,40
Rij 8: 1 * € 18,60 * 35 = € 651,00
Rij 14:1 * € 18,60 * 25 = € 465,00
Rij 21: 1 * € 18,60 * 21 = € 390,60
Totaal: € 1674,00

Maar hoe krijg je het voor elkaar dat alleen de rijen met “Tofu” worden berekend en wat doet die 1 eigenlijk? Daarvoor zorgt dit gedeelte:
– –(A2:A23=E2)

In kolom A wordt gekeken welk produkt voldoet aan het criterium in cel E2 (Tofu). Normaliter krijg je dan een reeks van FALSE en/of TRUE. De twee minnen (– –) aan het begin zorgen er echter voor dat als Tofu gevonden wordt er een 1 (i. p. v. TRUE) wordt gegenereerd. Zoniet dan wordt een 0 (i.p.v. FALSE) gegenereerd.

Optellen alle aankopen van één klant

03/02/2025Excel formulaadmin

Klant BERGS heeft diverse producten gekocht. We willen het totaal berekenen door van al zijn gekochte producten het subtotaal (Kolom E) op te tellen.

Formule in G5.
=SUMPRODUCT(($A$2:$A$10=$G$2)*($E$2:$E$10))

In G2 kun je een validatielijst maken met alle namen van de klanten.

Gegevens | Gegevensvalidatie | Gegevensvalidatie | Toestaan > Lijst | Bron > (type in het vak ->) ALFKI;BERGS;FAMIA
Let op de puntkomma tussen de klantnamen.

Unieke lijst maken en één product uitsluiten

03/02/2025Excel formulaadmin

Je hebt een lijst waarin dubbele waarden voorkomen. Je wilt een lijst maken met unieke waarden maar één waarde wil je uitsluiten/negeren.

Formule C7

=IFERROR(INDEX($A$7:$A$28;SMALL(IF(FREQUENCY(IF($A$7:$A$28<>””;IF(1-ISNUMBER(SEARCH($B$4;$A$7:$A$28));MATCH($A$7:$A$28;$A$7:$A$28;0)));ROW($A$7:$A$28)-ROW($A$7)+1);ROW($A$7:$A$28)-ROW($A$7)+1);ROWS(C$7:C7)));””)

Dit is een zogenaamde array formule, invoeren met: Ctrl+Shift+Enter, NIET alleen Enter. Als je dit goed hebt gedaan, plaatst Excel accolades om de formule { }. Let op: Plaats die accolades { } niet handmatig.

Let op: Plaats die accolades { } niet handmatig.
Doorvoeren naar beneden

Formule B3

=SUM(IF(FREQUENCY(IF($A$7:$A$28<>””;IF(1-ISNUMBER(SEARCH($B$4;$A$7:$A$28));MATCH($A$7:$A$28;$A$7:$A$28;0)));ROW($A$7:$A$28)-ROW($A$7)+1);1))

Let op: Plaats die accolades { } niet handmatig.

2 lijsten vergelijken

02/02/2025Excel VBAadmin

Je kent dat wel. Je hebt twee lijsten die gegevens bevatten. Nu wil je checken of de items in Lijst_2 voorkomen in Lijst_1. Als het lange lijsten zijn is dat een hels karwei. Bijvoorbeeld, komt “Drachenblut Delikatessen” voor in Lijst_1? Ja (TRUE). Komt “QUICK-Stop” voor in Lijst_1? Nee (FALSE).

Formule die je daarvoor kan gebruiken is simpel:

D1 =ISNUMBER(MATCH($B2;$A$2:$A$11;0))

Enter en doorvoeren naar beneden.

Wil je weten of een item NIET in Lijst_1 voorkomt dan gebruik je de formule:

E1 =ISNA(MATCH($B2;$A$2:$A$11;0))

Enter en doorvoeren naar beneden.

Webscrape voorbeeld

01/02/2025Excel VBAadmin

We gaan naar de website:
https://www.gameshop.nl/webshop/index.php

Om wat gegevens van computerspellen binnen te halen middels VBA-Code.

Voeg onderstaande code toe:

1. Kopieer de onderstaande code middels Ctrl + C
2. Druk op de toetscombinatie ALT + F11 om de Visual Basic Editor te openen
3. Druk op de toetscombinatie ALT + N om het menu Invoegen te openen
4. Druk op M om een standaard module in te voegen
5. Daar waar de cursor knippert voeg je de code in middels Ctrl + V
6. Druk op de toetscombinatie ALT + Q om terug te keren naar het Excel werkblad
7. Tenslotte ga naar View | Macros | View macros en kies je de juiste macro.

Sub Get_That_Data()
Dim HTMLdoc As HTMLDocument
Dim xmlhttp As New MSXML2.XMLHTTP60
Dim platformLinks As Object, titles As Object, prices As Object, i As Integer
    
    Set xmlhttp = New MSXML2.XMLHTTP60
    xmlhttp.Open "GET", "https://www.gameshop.nl/webshop/index.php", False
    xmlhttp.send
    Set HTMLdoc = CreateObject("htmlfile")
    HTMLdoc.body.innerHTML = xmlhttp.responseText
    'LogInformation (HTMLdoc.body.innerHTML)
        
    ' Get elements by class name
    Set platformLinks = HTMLdoc.getElementsByClassName("platform-link")
    Set titles = HTMLdoc.getElementsByClassName("titel")
    Set prices = HTMLdoc.getElementsByClassName("prijs")
    
    ' Output results to Immediate Window (Ctrl+G in VBA editor to view)
    For i = 0 To platformLinks.Length - 1
        Debug.Print "Platform: " & platformLinks.Item(i).innerText
        Debug.Print "Title: " & titles.Item(i).innerText
        Debug.Print "Price: " & prices.Item(i).innerText
        Debug.Print "----------------------------"
    Next i
End Sub

Sub Get_That_Data()

Dim HTMLdoc As HTMLDocument

Dim xmlhttp As New MSXML2.XMLHTTP60

Dim platformLinks As Object, titles As Object, prices As Object, i As Integer

Set xmlhttp = New MSXML2.XMLHTTP60

xmlhttp.Open "GET", "https://www.gameshop.nl/webshop/index.php", False

xmlhttp.send

Set HTMLdoc = CreateObject("htmlfile")

HTMLdoc.body.innerHTML = xmlhttp.responseText

'LogInformation (HTMLdoc.body.innerHTML)

' Get elements by class name

Set platformLinks = HTMLdoc.getElementsByClassName("platform-link")

Set titles = HTMLdoc.getElementsByClassName("titel")

Set prices = HTMLdoc.getElementsByClassName("prijs")

' Output results to Immediate Window (Ctrl+G in VBA editor to view)

For i = 0 To platformLinks.Length - 1

Debug.Print "Platform: " & platformLinks.Item(i).innerText

Debug.Print "Title: " & titles.Item(i).innerText

Debug.Print "Price: " & prices.Item(i).innerText

Debug.Print "----------------------------"

Next i

End Sub

Je kunt de opgehaalde broncode van de webpagina loggen (vastleggen) in een tekstbestand ter referentie. In bovenstaande code staat deze zin:

‘LogInformation (HTMLdoc.body.innerHTML)

Haal de apostrof die aan het begin van de zin staat weg. Vervolgens onderstaande code toevoegen:

Sub LogInformation(LogMessage As String)
Dim fileNum As Integer
Const LogFileName As String = "C:\temp\textfile.html"
    
    Open "C:\temp\textfile.html" For Output As #1: Close #1
    Debug.Print "Clear complete"

    fileNum = FreeFile ' next file number
    Open LogFileName For Append As #fileNum ' creates the file if it doesn't exist
    Print #fileNum, LogMessage ' write information at the end of the text file
    Close #fileNum ' close the file
End Sub

Sub LogInformation(LogMessage As String)

Dim fileNum As Integer

Const LogFileName As String = "C:\temp\textfile.html"

Open "C:\temp\textfile.html" For Output As #1: Close #1

Debug.Print "Clear complete"

fileNum = FreeFile ' next file number

Open LogFileName For Append As #fileNum ' creates the file if it doesn't exist

Print #fileNum, LogMessage ' write information at the end of the text file

Close #fileNum ' close the file

End Sub

Zorg dat je het bestand textfile.html in de juiste directory hebt staan namelijk:
C:\temp\textfile.html
Telkens als je logt wordt eerst de inhoud van dat bestand verwijderd en vervolgens wordt er nieuwe tekst naar geschreven.

Unieke lijst genereren

01/02/2025Excel formulaadmin

Een dynamische lijst maken. Dit betekent dat, naar mate je de lijst uitbreidt en dus langer maakt, de lijst zich als het ware aanpast.

We hebben namen van landen in Kolom A. Sommige landen staan er dubbel in of zelfs driedubbel. In Kolom C willen we slechts unieke namen van landen.

Aan de slag. Zorg dat je gegevens hebt zoals in de afbeelding. Vervolgens dien je een aantal namen met daaraan gekoppeld formules te maken. Doe dat zoals hieronder beschreven:

Formulas > Name manager > New
Name: = RowVector
Refers to:

=ROW(Items)-ROW(INDEX(Items;1;1))+1

Klik: OK

Formulas > Name manager > New
Name: = Items
Refers to:

=Sheet1!$A$4:INDEX(Sheet1!$A$4:$A$20;Lrow)

Klik: OK

Formulas > Name manager > New
Name: = Lrow
Refers to:

=MATCH(REPT(“z”;255);Sheet1!$A$4:$A$20)

Klik: OK

Tenslotte formules in de volgende cellen zetten:

Formule in C2

=SUM(IF(FREQUENCY(IF(1-(Items=””);MATCH(Items;Items;0));RowVector);1))

Let op: Plaats die accolades { } niet handmatig.

Formule in C4

=IF(ROWS($C$4:C4)<=$C$2;INDEX(Items;SMALL(IF(FREQUENCY(IF(1-(Items=””);MATCH(Items;Items;0));RowVector);RowVector);ROWS($C$4:C4)));””)

Ook dit is een zogenaamde array formule, invoeren met: Ctrl+Shift+Enter, NIET alleen Enter. Als je dit goed hebt gedaan, plaatst Excel accolades om de formule { }. Let op: Plaats die accolades { } niet handmatig.

Let op: Plaats die accolades { } niet handmatig.
Doorvoeren naar beneden

Totalen berekenen, 2 criteria

01/02/2025Excel formulaadmin

Een paar winkels (Kolom A) hebben goede (of slechte) zaken gedaan en je ziet de resultaten per dag (Kolommen B:G in de afbeelding. De opgave dit keer is om de totalen (Kolom F) te berekenen. Er zijn 2 criteria namelijk, bedrag >= €5000 en de datum moet liggen tussen 2-9-2016 en 5-9-2016.

Formule in H8

=SUMIFS(B8:G8;$B$7:$G$7;”>=”&DATE(2016;9;2);$B$7:$G$7;”<=”&DATE(2016;9;5);B8:G8;”>”&5000)

Doorvoeren naar beneden.

Wie heeft het meest verkocht per maand/jaar

01/02/2025Excel formulaadmin

De vertegenwoordigers hebben weer eens goed hun best gedaan maar wie heeft het meeste verkocht per maand en wie is de topverkoper van het jaar?

Formule in F2

Let op: Plaats die accolades { } niet handmatig.

Doorvoeren naar beneden

=IFERROR(INDEX($B$1:$E$1;SMALL(IF($B2:$E2=MAX($B2:$E2);COLUMN($B$1:$E$1)-COLUMN($B$1)+1);COLUMNS($F2:F2)));””)

Dream come true

https://whydonate.com/en/fundraising/cafe-restoration-project

Monthly Archives: February 2025

Export Range to HTML file

Totalen van verkoper berekenen

SOMPRODUCT met criterium

Optellen alle aankopen van één klant

Unieke lijst maken en één product uitsluiten

2 lijsten vergelijken

Webscrape voorbeeld

Unieke lijst genereren

Totalen berekenen, 2 criteria

Wie heeft het meest verkocht per maand/jaar