Create Visio flowchart diagram from Excel Row Data

M

muthus80

New Member
Joined
Jun 28, 2015
Messages
4
Hello,

Need the assistance on the following Excel requirement.

We will need to convert excel Row data into Visio Flowchart using VBA macro.

1. Each row in Excel need to be converted into Rectangle Shape in Visio diagram. At this time fine with only one shape but later based on row data we have to decide the shapes (like decision..etc)at run time. All the shapes need to be connected in the same visio drawing.
2. There is no limit in number of rows in excel and the entire row need to be converted into a single shape.
3. The row data will be in a single column of that row.

Example in Excel 4 rows of data like below:
Row 1: Login as guest user
Row 2: Provide the search creteria
Row 3: View the results.
Row 4: Logout.

The above has to be converted into 4 rectangle shapes and connected as a flowchart.

Please help me to write vba macro on this.

Thanks in advance.

Muthu.
 
Last edited:

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Sort by date Sort by votes
I am working on a mod that reduces the character size if the text is taller than the frame, but try this:

Code: 
Option Explicit

Dim AppVisio As Object

Sub CreateLinkedVisioBoxesForColumn1Data()
    'http://www.mrexcel.com/forum/excel-questions/865121-create-visio-flowchart-diagram-excel-row-data.html
    
    'For each cell in column A starting in A1, create a rectangle in Visio and connect to the next box
    Dim lLastRow As Long
    Dim aryRowData() As Variant
    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    aryRowData = Range(Cells(1, 1), Cells(lLastRow, 1)).Value
    DropStringOfBoxes aryRowData
    
    
    MsgBox lLastRow & " box drawing created.", , "Complete"
End Sub


Sub DropStringOfBoxes(aryRange() As Variant)
    'Given an array, create a grid of vision boxes connected in order
    
    'Dim aryRange() As Variant '(1,1)...(1,N)
    Dim aryContents() As Variant    '0...N
    Dim lAryIndex As Long
    Dim lAryRangeIndex As Long
    Dim lShapeIndex As Long
    Dim sngX As Single
    Dim sngY As Single
    Dim sngDeltaX As Single
    Dim sngDeltaY As Single
    Dim lLastDropIndex As Long
    Dim lCurrDropIndex As Long
    Dim bAllInSameVisio As Boolean
    
    bAllInSameVisio = True
    
    'If using hard-coded array
'    aryContents = Array("AAAAAAAAAA", "BBBBBBBBBB", "CCCCCCCCCC", "DDDDDDDDDD", "EEEEEEEEEE", "FFFFFFFFFF", "GGGGGGGGGG")
    
    'If using a selection as input (Only takes cells in first area, read Left to Right, Top to Bottom
'    aryRange = Selection.Value
'    For lAryIndex = 1 To Selection.Cells.Count
'        ReDim Preserve aryContents(0 To lAryRangeIndex)
'        aryContents(lAryRangeIndex) = Selection.Cells(lAryIndex)
'        lAryRangeIndex = lAryRangeIndex + 1
'    Next

    'If using input parameter array
    For lAryIndex = LBound(aryRange, 1) To UBound(aryRange, 1)
        ReDim Preserve aryContents(0 To lAryRangeIndex)
        aryContents(lAryRangeIndex) = aryRange(lAryIndex, 1)
        lAryRangeIndex = lAryRangeIndex + 1
    Next
    
    sngDeltaX = 2
    sngDeltaY = 1.25
    sngX = 1
    sngY = 10.25
    
    If bAllInSameVisio Then
        'Is Visio already running
        On Error Resume Next
        ' Check whether PowerPoint is running
        Set AppVisio = GetObject(, "Visio.Application")
        If AppVisio Is Nothing Then
            ' Visio is not running, create new instance
            Set AppVisio = CreateObject("visio.Application")
            AppVisio.Visible = True
        End If
    Else
        'Open new copy of Visio
        Set AppVisio = CreateObject("visio.Application")
        AppVisio.Visible = True
    End If
    
    'Add New Drawing
    AppVisio.Documents.AddEx "basicd_u.vst", 0, 0
    'Open Stencils if other shapes are required
    'AppVisio.Documents.OpenEx "comps_u.vss", 2 + 4  'visOpenRO + visOpenDocked
    'AppVisio.Documents.OpenEx "periph_u.vss", 2 + 4 'visOpenRO + visOpenDocked
    'AppVisio.Documents.OpenEx "basic_u.vss", 2 + 4  'visOpenRO + visOpenDocked
    
    'Drop first shape
    AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item("BASIC_U.VSS").Masters.ItemU("Rectangle"), sngX, sngY
    lLastDropIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
    SetShapeText lLastDropIndex, CStr(aryContents(0))
    
    For lShapeIndex = LBound(aryContents) + 1 To UBound(aryContents)
        'Calculate Position
        sngY = sngY - sngDeltaY
        If sngY < 1 Then
            sngY = 10.25
            sngX = sngX + sngDeltaX
        End If
        
        'Save index of last dropped stencil
        lLastDropIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
        
        'Drop Current stencil
        AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item("BASIC_U.VSS").Masters.ItemU("Rectangle"), sngX, sngY
        lCurrDropIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
        SetShapeText lCurrDropIndex, CStr(aryContents(lShapeIndex))
        
        'Connect Last to Current
        AppVisio.ActivePage.Shapes.ItemFromID(lLastDropIndex).AutoConnect AppVisio.ActivePage.Shapes.ItemFromID(lCurrDropIndex), 0
        
        'Save Current as Last (for next loop)
        lLastDropIndex = lCurrDropIndex
        
    Next
    Set AppVisio = Nothing
End Sub

Sub SetShapeText(lShapeID As Long, sEntry As String)
    'Add Text to Shape
    Dim vsoCharacters1 As Object
    
    Set vsoCharacters1 = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).Characters
    vsoCharacters1.Begin = 0
    vsoCharacters1.End = 0
    vsoCharacters1.Text = sEntry
    AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).CellsSRC(3, 0, 7).formulau = "18 pt"     'visSectionCharacter, 0, visCharacterSize
     
    'AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).CellsSRC(1, 5, 1).formulau 'visSectionObject,visRowEvent,visEvtCellTheText
    
    Set vsoCharacters1 = Nothing

End Sub
 
Upvote 0
This wasn't even my request, but I am loving it. I can't believe it can even be done.

I don't want to redirect the conversation in this thread or steal away from the OPs original question, but my god, if something similar could be done to create (horizontal) swim lane charts, I would die, go to heaven, and finally undertake mapping out all of the processes in my ops manual - a project I have been putting off for 2 years because of the tedious nature. Phil, is it possible to even accomplish such things as including decision boxes and so forth and creating this into swim lanes instead of a plain work area?
 
Upvote 0
This is awesome Phil. This is exactly what I needed. Let me explore further to make a decision box based on the content like if content has "if" keyword. I will post again here if any help needed. Really appreciated your timely help. Meanwhile if you have tuned code, please post here.
 
Upvote 0
This version will reduce the font size of text in a box from default size of 18 (by .5 down to 8) to attempt to fit it inside that box.

Code: 
    Option Explicit
    Dim AppVisio As Object

    Sub CreateLinkedVisioBoxesForColumn1Data()
        'http://www.mrexcel.com/forum/excel-questions/865121-create-visio-flowchart-diagram-excel-row-data.html
        
        'For each cell in column A starting in A1, create a rectangle in Visio and connect to the next box
        
        'Note, if you turn off Visio ScreenUpdating, then the font size reduction feature will not work correctly.
        '  apparently the ShapeSheet TextHeight & TextWidth functions need the ScreenUpdating = True to work.
        '  So live with the flicker.
        
        Dim lLastRow As Long
        Dim aryRowData() As Variant
        
        lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
        aryRowData = Range(Cells(1, 1), Cells(lLastRow, 1)).Value
        
        DropStringOfBoxes aryRowData
        
        MsgBox lLastRow & " box drawing created.", , "Complete"
        
    End Sub

    Sub DropStringOfBoxes(aryRange() As Variant)
        'Given an array, create a grid of vision boxes connected in order
        
        'Dim aryRange() As Variant '(1,1)...(1,N)
        Dim aryContents() As Variant    '0...N
        Dim lAryIndex As Long
        Dim lAryRangeIndex As Long
        Dim lShapeIndex As Long
        Dim sngX As Single
        Dim sngY As Single
        Dim sngDeltaX As Single
        Dim sngDeltaY As Single
        Dim lLastDropIndex As Long
        Dim lCurrDropIndex As Long
        Dim bAllInSameVisio As Boolean
        
        bAllInSameVisio = True
        
        'If using hard-coded array
    '    aryContents = Array("AAAAAAAAAA", "BBBBBBBBBB", "CCCCCCCCCC", "DDDDDDDDDD", "EEEEEEEEEE", "FFFFFFFFFF", "GGGGGGGGGG")
        
        'If using a selection as input (Only takes cells in first area, read Left to Right, Top to Bottom
    '    aryRange = Selection.Value
    '    For lAryIndex = 1 To Selection.Cells.Count
    '        ReDim Preserve aryContents(0 To lAryRangeIndex)
    '        aryContents(lAryRangeIndex) = Selection.Cells(lAryIndex)
    '        lAryRangeIndex = lAryRangeIndex + 1
    '    Next

        'If using input parameter array
        For lAryIndex = LBound(aryRange, 1) To UBound(aryRange, 1)
            ReDim Preserve aryContents(0 To lAryRangeIndex)
            aryContents(lAryRangeIndex) = aryRange(lAryIndex, 1)
            lAryRangeIndex = lAryRangeIndex + 1
        Next
        
        sngDeltaX = 2
        sngDeltaY = 1.25
        sngX = 1
        sngY = 10.25
        
        If bAllInSameVisio Then
            'Is Visio already running
            On Error Resume Next
            ' Check whether Visio is running
            Set AppVisio = GetObject(, "Visio.Application")
            If AppVisio Is Nothing Then
                ' Visio is not running, create new instance
                Set AppVisio = CreateObject("visio.Application")
                AppVisio.Visible = True
            End If
        Else
            'Open new copy of Visio
            Set AppVisio = CreateObject("visio.Application")
            AppVisio.Visible = True
        End If
        On Error GoTo 0
        
        'Add New Drawing
        AppVisio.Documents.AddEx "basicd_u.vst", 0, 0
        'Open Stencils if other shapes are required
        'AppVisio.Documents.OpenEx "comps_u.vss", 2 + 4  'visOpenRO + visOpenDocked
        'AppVisio.Documents.OpenEx "periph_u.vss", 2 + 4 'visOpenRO + visOpenDocked
        'AppVisio.Documents.OpenEx "basic_u.vss", 2 + 4  'visOpenRO + visOpenDocked
        
        'Drop first shape
        AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item("BASIC_U.VSS").Masters.ItemU("Rectangle"), sngX, sngY
        lLastDropIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
        SetShapeText lLastDropIndex, CStr(aryContents(0))
        
        For lShapeIndex = LBound(aryContents) + 1 To UBound(aryContents)
            'Calculate Position
            sngY = sngY - sngDeltaY
            If sngY < 1 Then
                sngY = 10.25
                sngX = sngX + sngDeltaX
            End If
            
            'Save index of last dropped stencil
            lLastDropIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
            
            'Drop Current stencil
            AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item("BASIC_U.VSS").Masters.ItemU("Rectangle"), sngX, sngY
            lCurrDropIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
            SetShapeText lCurrDropIndex, CStr(aryContents(lShapeIndex))
            
            'Connect Last to Current
            AppVisio.ActivePage.Shapes.ItemFromID(lLastDropIndex).AutoConnect AppVisio.ActivePage.Shapes.ItemFromID(lCurrDropIndex), 0
            
            'Save Current as Last (for next loop)
            lLastDropIndex = lCurrDropIndex
            
        Next
        
        Set AppVisio = Nothing
        
    End Sub

    Sub SetShapeText(lShapeID As Long, sEntry As String)
        'Add Text to Shape, reduce font size from the default size if the text is outside the shame
        
        Dim vsoCharacters1 As Object
        Dim sShapename As String
        Dim sngTextHeight As Single
        Dim sngFontDefaultSize As Single
        Dim vShapeheight As Variant
        
        sngFontDefaultSize = 18     'Initial size of font in points
        sngFontMinimumSize = 8      'Minimum size of font in points
        
        Set vsoCharacters1 = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).Characters
        vsoCharacters1.Begin = 0
        vsoCharacters1.End = 0
        vsoCharacters1.Text = sEntry
        AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).CellsSRC(3, 0, 7).FormulaU = sngFontDefaultSize & " pt"    'visSectionCharacter, 0, visCharacterSize
        
        vShapeheight = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).CellsSRC(1, 1, 3).FormulaU  'visSectionObject, visRowXFormOut, visXFormHeight
        vShapeheight = Replace(vShapeheight, " in", "")
        
        'Add a user-defined cell that contains the height of the textbox
        AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).OpenSheetWindow  'Open Shape ShapeSheet
        AppVisio.ActiveWindow.Shape.AddRow 242, 0, 0 'visSectionUser, 0, visTagDefault
        AppVisio.ActiveWindow.Shape.CellsSRC(242, 3, 0).RowNameU = "TextHeight" 'visSectionUser, 3, visUserValue
        AppVisio.ActiveWindow.Shape.CellsSRC(242, 3, 0).FormulaU = "TEXTHEIGHT(TheText,width)" 'visSectionUser, 3, visUserValue
        
        'If the text box is taller than the shape height, reduce text font size by .5 pt until it is smaller or font size = 8 pt
        sngTextHeight = AppVisio.ActiveWindow.Shape.CellsSRC(242, 3, 0) 'visSectionUser, 3, visUserValue
        Do While sngTextHeight > vShapeheight And sngFontDefaultSize > sngFontMinimumSize
            sngFontDefaultSize = sngFontDefaultSize - 0.5
            sngTextHeight = AppVisio.ActiveWindow.Shape.CellsSRC(242, 3, 0) 'visSectionUser, 3, visUserValue
            AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).CellsSRC(3, 0, 7).FormulaU = sngFontDefaultSize & " pt"
        Loop
        AppVisio.ActiveWindow.Close 'Close Shape ShapeSheet
        
        Set vsoCharacters1 = Nothing

    End Sub
 
Upvote 0
Code updated to eliminate opening shape sheet

Code: 
Option Explicit
Dim AppVisio As Object

Sub CreateLinkedVisioBoxesForColumn1Data()
    'http://www.mrexcel.com/forum/excel-questions/865121-create-visio-flowchart-diagram-excel-row-data.html
    
    'For each cell in column A starting in A1, create a rectangle in Visio and connect to the next box
    
    'Note, if you turn off Visio ScreenUpdating, then the font size reduction feature will not work correctly.
    '  apparently the ShapeSheet TextHeight & TextWidth functions need the ScreenUpdating = True to work.
    '  So live with the flicker.
    
    Dim lLastRow As Long
    Dim aryRowData() As Variant
    
    Worksheets("Sheet1").Select
    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    aryRowData = Range(Cells(1, 1), Cells(lLastRow, 1)).Value
    
    DropStringOfBoxes aryRowData
    
    MsgBox lLastRow & " box drawing created.", , "Complete"
    
End Sub

Sub DropStringOfBoxes(aryRange() As Variant)
    'Given an array, create a grid of vision boxes connected in order
    
    'Dim aryRange() As Variant '(1,1)...(1,N)
    Dim aryContents() As Variant    '0...N
    Dim laryIndex As Long
    Dim lAryRangeIndex As Long
    Dim lShapeIndex As Long
    Dim sngX As Single
    Dim sngY As Single
    Dim sngDeltaX As Single
    Dim sngDeltaY As Single
    Dim lLastDropIndex As Long
    Dim lCurrDropIndex As Long
    Dim bAllInSameVisio As Boolean
    
    bAllInSameVisio = True
    
    'If using hard-coded array
'    aryContents = Array("AAAAAAAAAA", "BBBBBBBBBB", "CCCCCCCCCC", "DDDDDDDDDD", "EEEEEEEEEE", "FFFFFFFFFF", "GGGGGGGGGG")
    
    'If using a selection as input (Only takes cells in first area, read Left to Right, Top to Bottom
'    aryRange = Selection.Value
'    For lAryIndex = 1 To Selection.Cells.Count
'        ReDim Preserve aryContents(0 To lAryRangeIndex)
'        aryContents(lAryRangeIndex) = Selection.Cells(lAryIndex)
'        lAryRangeIndex = lAryRangeIndex + 1
'    Next

    'If using input parameter array
    For laryIndex = LBound(aryRange, 1) To UBound(aryRange, 1)
        ReDim Preserve aryContents(0 To lAryRangeIndex)
        aryContents(lAryRangeIndex) = aryRange(laryIndex, 1)
        lAryRangeIndex = lAryRangeIndex + 1
    Next
    
    sngDeltaX = 2
    sngDeltaY = 1.25
    sngX = 1
    sngY = 10.25
    
    If bAllInSameVisio Then
        'Is Visio already running
        On Error Resume Next
        ' Check whether Visio is running
        Set AppVisio = GetObject(, "Visio.Application")
        If AppVisio Is Nothing Then
            ' Visio is not running, create new instance
            Set AppVisio = CreateObject("visio.Application")
            AppVisio.Visible = True
        End If
    Else
        'Open new copy of Visio
        Set AppVisio = CreateObject("visio.Application")
        AppVisio.Visible = True
    End If
    On Error GoTo 0
    
    'Add New Drawing
    AppVisio.Documents.AddEx "basicd_u.vst", 0, 0
    'Open Stencils if other shapes are required
    'AppVisio.Documents.OpenEx "comps_u.vss", 2 + 4  'visOpenRO + visOpenDocked
    'AppVisio.Documents.OpenEx "periph_u.vss", 2 + 4 'visOpenRO + visOpenDocked
    'AppVisio.Documents.OpenEx "basic_u.vss", 2 + 4  'visOpenRO + visOpenDocked
    
    'Iterate Array
    
    
    
    
    
    AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item("BASIC_U.VSS").Masters.ItemU("Rectangle"), sngX, sngY
    lLastDropIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
    SetShapeText lLastDropIndex, CStr(aryContents(0))
    
    For lShapeIndex = LBound(aryContents) + 1 To UBound(aryContents)
        'Calculate Position
        sngY = sngY - sngDeltaY
        If sngY < 1 Then
            sngY = 10.25
            sngX = sngX + sngDeltaX
        End If
        
        'Save index of last dropped stencil
        lLastDropIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
        
        'Drop Current stencil
        AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item("BASIC_U.VSS").Masters.ItemU("Rectangle"), sngX, sngY
        lCurrDropIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
        SetShapeText lCurrDropIndex, CStr(aryContents(lShapeIndex))
        
        'Connect Last to Current
        AppVisio.ActivePage.Shapes.ItemFromID(lLastDropIndex).AutoConnect AppVisio.ActivePage.Shapes.ItemFromID(lCurrDropIndex), 0
        
        'Save Current as Last (for next loop)
        lLastDropIndex = lCurrDropIndex
        
    Next
    
    Set AppVisio = Nothing
    
End Sub

Sub SetShapeText(lShapeID As Long, sEntry As String)
    'Add Text to Shape, reduce font size from the default size if the text is outside the shame
    
    Dim vsoCharacters1 As Object
    Dim sShapename As String
    Dim sngTextHeight As Single
    Dim sngFontDefaultSize As Single
    Dim vShapeheight As Variant
    Dim sngFontMinimumSize As Long
    
    sngFontDefaultSize = 18     'Initial size of font in points
    sngFontMinimumSize = 8      'Minimum size of font in points
    
    Set vsoCharacters1 = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).Characters
    vsoCharacters1.Begin = 0
    vsoCharacters1.End = 0
    vsoCharacters1.Text = sEntry
    AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).CellsSRC(3, 0, 7).FormulaU = sngFontDefaultSize & " pt"    'visSectionCharacter, 0, visCharacterSize
    
    vShapeheight = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).CellsSRC(1, 1, 3).FormulaU  'visSectionObject, visRowXFormOut, visXFormHeight
    vShapeheight = Replace(vShapeheight, " in", "")
    
    'Add a user-defined cell that contains the height of the textbox
    'AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).OpenSheetWindow  'Open Shape ShapeSheet
    AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).AddRow 242, 0, 0 'visSectionUser, 0, visTagDefault
    AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).CellsSRC(242, 3, 0).RowNameU = "TextHeight" 'visSectionUser, 3, visUserValue
    AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).CellsSRC(242, 3, 0).FormulaU = "TEXTHEIGHT(TheText,width)" 'visSectionUser, 3, visUserValue
    
    'If the text box is taller than the shape height, reduce text font size by .5 pt until it is smaller or font size = 8 pt
    sngTextHeight = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).CellsSRC(242, 3, 0) 'visSectionUser, 3, visUserValue
    Do While sngTextHeight > vShapeheight And sngFontDefaultSize > sngFontMinimumSize
        sngFontDefaultSize = sngFontDefaultSize - 0.5
        sngTextHeight = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).CellsSRC(242, 3, 0)  'visSectionUser, 3, visUserValue
        AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).CellsSRC(3, 0, 7).FormulaU = sngFontDefaultSize & " pt"
    Loop
    'AppVisio.ActiveWindow.Close 'Close Shape ShapeSheet
    
    Set vsoCharacters1 = Nothing

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
Excel VB Organogram
Replies
1
Views
97
anuradhagrewal
A
J
  • Question
Issues looping through excel data range when blank rows/cells are introduced.
Replies
6
Views
545
Skyybot
Skyybot
V
  • Question
Dynamic process diagram / flowchart
Replies
0
Views
597
vladimiratanasiu
V
B
  • Question
Add new Row in ListObject Table with data from an Array
Replies
4
Views
118
Akuini
Akuini
M
  • Solved
Cut/paste last 36 rows and move to a new worksheet
Replies
3
Views
85
RobP
R

Forum statistics

Threads
1,215,219
Messages
6,123,689
Members
449,117
Latest member
Aaagu

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top