Neuro Innovation: Excel VBA Automation

Excel VBA Automation

Typical uses

Automated generation of web code

Financial applications

eMail marketing automation

Automated surveys

Generating automated reports eg web based

Project management automation

Data / database / data list cleaning (very effective!)

Any repetitive task...

Excel remains a very powerful business tool - one could argue that business would not be what it is today without Excel / spreadsheets in general. Yet most organisations invest vast sums of money in developing new systems in circumstances where a simple Excel solution would be far more appropriate.

In the early days we had spreadsheet formulae, then the ability to record macros - now we have Visual Basic for Applications (VBA). It is a powerful development language in its own right and is perfectly suited to the task of automating simple business processes.

If you think that VBA can only handle a few basic programmatic concepts you would be mistaken - it is a powerful development language in its own right and is perfectly suited when a rapid solution is required.

To access the VBA development environment within Excel press Alt and F11. To start new procedure enter "sub test" then press enter. Excel should add "end sub" automatically. You can then copy and paste the following snippets, pressing the "Run" button that the top of the screen to run your test procedure. NB work on a blank worksheet.

VBA Code Examples

Loop through a sheet

Write to a text output file

Read from a text file

Select sheet / range / cell

Do something with a selection

Run code on opening the sheet

Get feedback - messagebox and inputbox

Write to a cell / read from a cell

Replace some text in a cell

Logic - it then else

Full VBA Examples

Here are a few code-snippets to show you some of the things that VBA can do for you:

This example shows looping and accessing an external text file (loading the entire textfile into a memory based array would have been more efficient)

Open a text file containing a list of company names
Find the column titled "company name"
Find the next available free column also
Hilite matches between the external list of company and the list in your spreadsheet
Diplay a message when done

sub test()

Open "C:\Folder\textfile.txt" For Input As #1

CnameV = "Company Name"

Do While Not EOF(1) ' Loop until end of file.
    Line Input #1, External_CnameV ' Read line into variable.
        
    comp_col = 0
    Do Until ActiveSheet.Cells(1, col_no) = ""
        this_cell = Trim(ActiveSheet.Cells(1, col_no))
        If UCase(this_cell) = UCase(CnameV) Then comp_col = col_no
        col_no = col_no + 1
        next_col = col_no
    Loop
        
    XROWS = 2 ' assumes row 1 contains headers
    Do Until Trim(ActiveSheet.Cells(XROWS, comp_col)) = ""
    	If Trim(UCase(ActiveSheet.Cells(XROWS, comp_col))) = Trim(UCase(External_CnameV)) Then
            
	        ActiveSheet.Cells(XROWS, next_col) = "Y"
        	Rows(XROWS).Select
        	With Selection.Interior
            	.ColorIndex = 39
            	.Pattern = xlSolid
        	End With
            
    	End If
        XROWS = XROWS + 1
    Loop
    
Loop
MsgBox ("Complete - matched rows hilited in lavendar")

Close #1

End Sub

This example generates an html report containing contacts for a company / address.

Sub basic_report() XROWS = 2 count = 0 limit = 3 If Trim(ActiveSheet.Cells(1, 1)) <> "Company Name" Then MsgBox ("Error - company name not at left hand side") Exit Sub End If outfile1 = "c:\excel\web_out.html" Open outfile1 For Output As #1 Print #1, "<html>" Print #1, "<head>" Print #1, "<TITLE>" Print #1, "</TITLE>" Print #1, "<meta name="viewport" content="width=device-width, initial-scale=1"> </head>" Print #1, "<body>" Do Until Trim(ActiveSheet.Cells(XROWS, 1)) = "" Call printtextline1 XROWS = XROWS + 1 ' break page if new company or change of address If (ActiveSheet.Cells(XROWS, 1) <> ActiveSheet.Cells(XROWS - 1, 1)) _ Or (ActiveSheet.Cells(XROWS, 4) <> ActiveSheet.Cells(XROWS - 1, 4)) Then count = limit End If If count >= limit Then Print #1, "<p class="breakhere">" count = 0 End If Loop Print #1, "</body>" Print #1, "</html>" Close #1 End Sub Sub printtextline1() YCOLS = 1 Do Until ActiveSheet.Cells(1, YCOLS) = "" 'print company details If YCOLS >= 1 And YCOLS <= 3 And ActiveSheet.Cells(XROWS - 1, 1) _ <> ActiveSheet.Cells(XROWS, 1) Then If YCOLS = 1 Then Print #1, "<h1>COMPANY DETAIL</h1>" Print #1, "<TABLE width=""100%"" border=1>" End If Call print_cell If YCOLS = 3 Then Print #1, "</TABLE>" Print #1, "<p> </p>" count = count + 1 End If End If 'print address details If (YCOLS >= 4 And YCOLS <= 13) And _ (ActiveSheet.Cells(XROWS - 1, 1) & ActiveSheet.Cells(XROWS - 1, 4) <> _ ActiveSheet.Cells(XROWS, 1) & ActiveSheet.Cells(XROWS, 4)) Then If YCOLS = 4 Then Print #1, "<h2>Address for " & Trim(ActiveSheet.Cells(XROWS, 1)) & "</h2>" Print #1, "<TABLE width=""100%"" border=2>" End If Call print_cell If YCOLS = 13 Then Print #1, "</TABLE>" count = count + 2 Print #1, "<p> </p>" End If End If If YCOLS >= 14 And YCOLS <= 23 Then 'print person details If YCOLS = 14 Then Print #1, "<TABLE width=""100%"" border=1>" End If Call print_cell If YCOLS = 23 Then Print #1, "</TABLE>" Print #1, "<p> </p>" count = count + 1 End If End If YCOLS = YCOLS + 1 Loop End Sub Sub print_cell() SP_LEN = 35 - Len(ActiveSheet.Cells(1, YCOLS)) SPACER = String(SP_LEN, " ") Print #1, "<TR><TD width=""40%"">" & Trim(ActiveSheet.Cells(1, YCOLS)) & "</TD>" & "<TD width=""60%"">" & Trim(ActiveSheet.Cells(XROWS, YCOLS)) & "</TD></TR>" End Sub

A simple utility to group and outline eg similar company records

' group and outline facility Sub group() XROWS = 2 Start = 0 Do Until Trim(ActiveSheet.Cells(XROWS, 1)) = "" If ActiveSheet.Cells(XROWS, 1) <> ActiveSheet.Cells(XROWS - 1, 1) Then Start = XROWS + 1 End If If ActiveSheet.Cells(XROWS, 1) <> ActiveSheet.Cells(XROWS + 1, 1) _ And ActiveSheet.Cells(XROWS, 1) = ActiveSheet.Cells(XROWS - 1, 1) Then test = Trim(Str(Start)) & ":" & Trim(Str(XROWS)) Rows(test).Select Selection.Rows.group End If XROWS = XROWS + 1 Loop End Sub

Glossary: excel automation, excel vba, excel visual basic for applications, high wycombe, neuro innovation, finance automation, financial automation

EMDR, Hypnotherapy and Hypnosis in High Wycombe and Central London | () | Psychotherapy, hypnotherapy and hypnosis in High Wycombe