I have a program, that works, I just feel that it is running slower than it should and I feel that it is a bit more unstable than it should be. I am looking for tips on writing "better" code and making my program more stable.

I am looking to better this part of my code for now:

```vb
Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False

    'Removes shapes already there that will be updated by the getWeather function
    For Each delShape In Shapes
        If delShape.Type = msoAutoShape Then delShape.Delete
    Next delShape

    'Calls a function to get weather data from a web service
    Call getWeather("", "Area1")
    Call getWeather("", "Area2")
    Call getWeather("", "Area3")

    'Starting to implement the first connection to a SQL Access database.
    Dim cn As Object
    Dim rs As Object

    'Set cn and sqlConnect as ADODB-objects. Set rs as recordset
    Set cn = CreateObject("ADODB.Connection")
    Set sqlConnect = New ADODB.Connection
    Set rs = CreateObject("ADODB.RecordSet")

    'Set sqlConnect as connection string
    sqlConnect.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\databases\database.accdb;Persist Security Info=False;"

    'Open connection string via connection object
    cn.Open sqlConnect

'Set rs.Activeconnection to cn
rs.ActiveConnection = cn

'Get a username from the application to be used further down
Brukernavn = Application.userName

'This part of the code re-arranges the date format from american to european
StartDate = Date
EndDate = Date - 7

midStartDate = Split(StartDate, ".")
midEndDate = Split(EndDate, ".")

StartDate2 = "" & midStartDate(1) & "/" & midStartDate(0) & "/" & midStartDate(2) & ""
EndDate2 = "" & midEndDate(1) & "/" & midEndDate(0) & "/" & midEndDate(2) & ""

'SQL statement to get data from the access database
rs.Open "SELECT [RefNr], [Registrert Av],[Nettstasjon], [Meldt Dato] , [Bestilling], [Sekundærstasjon], [Avgang], [Hovedkomponent], [HovedÅrsak], [Status Bestilling] FROM [tblDatabase]" & _
"WHERE [Registrert Av] = '" & Brukernavn & "' AND [Loggtype] <> 'Beskjed' AND [Meldt Dato] BETWEEN #" & StartDate2 & "# AND # " & EndDate2 & "#" & _
"ORDER BY [Meldt Dato] DESC;", _
         cn, adOpenStatic

'Start to insert data from access database into a list
Dim i As Integer
Dim u As Integer

If Not rs.EOF Then
    rs.MoveFirst
End If
i = 0
With lst_SisteFeil
        .Clear
        Do
            If Not rs.EOF Then
                .AddItem
                If Not IsNull(rs!refnr) Then
                    .List(i, 0) = rs![refnr]
                End If

                If IsDate(rs![Meldt Dato]) Then
                    .List(i, 1) = Format(rs![Meldt Dato], "dd/mm/yy")
                End If

                .List(i, 4) = rs![nettstasjon]

                If Not IsNull(rs![Sekundærstasjon]) Then
                    .List(i, 2) = rs![Sekundærstasjon]
                End If

                If Not IsNull(rs![Avgang]) Then
                    .List(i, 3) = rs![Avgang]
                End If

                If Not IsNull(rs![Hovedkomponent]) Then
                    .List(i, 5) = rs![Hovedkomponent]
                End If

                If Not IsNull(rs![HovedÅrsak]) Then
                    .List(i, 6) = rs![HovedÅrsak]
                End If

                If Not IsNull(rs![Status Bestilling]) Then
                    .List(i, 7) = rs![Status Bestilling]
                End If

                If Not IsNull(rs![bestilling]) Then
                    .List(i, 8) = rs![bestilling]
                End If

                i = i + 1
                rs.MoveNext
            Else
                GoTo endOfFile
            End If
        Loop Until rs.EOF
End With
endOfFile:

rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing

'Starts to connect to SQL access database again to get different set of data. This must be possible to make more efficient?
Dim cn2 As Object
Dim rs2 As Object

'Set cn and sqlConnect as ADODB-objects. Set rs as recordset
Set cn2 = CreateObject("ADODB.Connection")
Set sqlConnect2 = New ADODB.Connection
Set rs2 = CreateObject("ADODB.RecordSet")

'Set sqlConnect as connection string
sqlConnect2.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\databases\database.accdb;Persist Security Info=False;"

'Open connection string via connection object
cn2.Open sqlConnect

'Set rs.Activeconnection to cn
rs2.ActiveConnection = cn2

'Second SQL statement
rs2.Open "SELECT [RefNr], [Registrert Av],[Nettstasjon], [Meldt Dato] , [Bestilling], [Sekundærstasjon], [Avgang], [Hovedkomponent], [HovedÅrsak], [Status Bestilling] FROM [tblDatabase]" & _
"WHERE [Registrert Av] <> '" & Brukernavn & "' AND [Meldt Dato] BETWEEN #" & StartDate2 & "# AND # " & EndDate2 & "#" & _
"ORDER BY [Meldt Dato] DESC;", _
         cn2, adOpenStatic

'Inserting into second list
If Not rs2.EOF Then
    rs2.MoveFirst
End If
u = 0
With lst_AlleFeil
        .Clear
        Do
            If Not rs2.EOF Then
                .AddItem
                If Not IsNull(rs2!refnr) Then
                    .List(u, 0) = rs2![refnr]
                End If

                If IsDate(rs2![Meldt Dato]) Then
                    .List(u, 1) = Format(rs2![Meldt Dato], "dd/mm/yy")
                End If

                .List(u, 4) = rs2![nettstasjon]

                If Not IsNull(rs2![Sekundærstasjon]) Then
                    .List(u, 2) = rs2![Sekundærstasjon]
                End If

                If Not IsNull(rs2![Avgang]) Then
                    .List(u, 3) = rs2![Avgang]
                End If

                If Not IsNull(rs2![Hovedkomponent]) Then
                    .List(u, 5) = rs2![Hovedkomponent]
                End If

                If Not IsNull(rs2![HovedÅrsak]) Then
                    .List(u, 6) = rs2![HovedÅrsak]
                End If

                If Not IsNull(rs2![Status Bestilling]) Then
                    .List(u, 7) = rs2![Status Bestilling]
                End If

                If Not IsNull(rs2![bestilling]) Then
                    .List(u, 8) = rs2![bestilling]
                End If

                u = u + 1
                rs2.MoveNext
            Else
                GoTo endOfFile2
            End If
        Loop Until rs2.EOF
End With
endOfFile2:

rs2.Close
cn2.Close
Set rs2 = Nothing
Set cn2 = Nothing

'Starting to connect to the database for the third time
Dim cn3 As Object
Dim rs3 As Object

'Set cn and sqlConnect as ADODB-objects. Set rs as recordset
Set cn3 = CreateObject("ADODB.Connection")
Set sqlConnect3 = New ADODB.Connection
Set rs3 = CreateObject("ADODB.RecordSet")

'Set sqlConnect as connection string
sqlConnect3.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\databases\database.accdb;Persist Security Info=False;"

'Open connection string via connection object
cn3.Open sqlConnect

'Set rs.Activeconnection to cn
rs3.ActiveConnection = cn3

'third sql statement
rs3.Open "SELECT [RefNr], [Registrert Av],[Nettstasjon], [Meldt Dato], [Sekundærstasjon], [Avgang], [Beskrivelse], [Til Dato] FROM [tblDatabase]" & _
"WHERE [Loggtype] = 'Beskjed' AND [Meldt Dato] >= DateAdd('d',-30,Date())" & _
"ORDER BY [Meldt Dato] DESC;", _
         cn3, adOpenStatic

'Inserting data in to third list
If Not rs3.EOF Then
    rs3.MoveFirst
End If

j = 0
With lst_beskjeder
        .Clear
        Do
            If Not rs3.EOF Then
                .AddItem
                If Not IsNull(rs3!refnr) Then
                    .List(j, 0) = rs3![refnr]
                End If

                If IsDate(rs3![Meldt Dato]) Then
                    .List(j, 1) = Format(rs3![Meldt Dato], "dd/mm/yy")
                End If

                .List(j, 4) = rs3![nettstasjon]

                If Not IsNull(rs3![Sekundærstasjon]) Then
                    .List(j, 2) = rs3![Sekundærstasjon]
                End If

                If Not IsNull(rs3![Avgang]) Then
                    .List(j, 3) = rs3![Avgang]
                End If

                If Not IsNull(rs3![beskrivelse]) Then
                    .List(j, 5) = rs3![beskrivelse]
                End If

                j = j + 1
                rs3.MoveNext
            Else
                GoTo endOfFile3
            End If
        Loop Until rs3.EOF
End With
endOfFile3:

rs3.Close
cn3.Close
Set rs3 = Nothing
Set cn3 = Nothing
End Sub

```

Here is the function I have used to get weather data.

```vb
Public Sub getWeather(APIurl As String, sted As String)

Dim i As Integer
i = 0

Dim omraade As String
omraade = ""

omraade = sted

If sted = "Area1" Then
    i = 4
ElseIf sted = "Area2" Then
    i = 6
ElseIf sted = "Area3" Then
    i = 8
End If

Dim WS As Worksheet: Set WS = ActiveSheet

Dim delShape As Shape
Dim city As String
Dim Req As New XMLHTTP
Req.Open "GET", "" & APIurl & "", False
Req.Send

Dim Resp As New DOMDocument
Resp.LoadXML Req.responseText

Dim Weather As IXMLDOMNode
Dim wShape As Shape
Dim thisCell As Range

For Each Weather In Resp.getElementsByTagName("current_condition")

    Set thisCell = WS.Range(Cells(2, i), Cells(2, i))
    Set wShape = WS.Shapes.AddShape(msoShapeRectangle, thisCell.Left, thisCell.Top, thisCell.Width, thisCell.Height)

    wShape.Fill.UserPicture Weather.ChildNodes(4).Text 'img

   Cells(3, i).Value = "" & Weather.ChildNodes(7).Text * 0.28 & " m/s" 'windspeedkmph
   Cells(4, i).Value = Weather.ChildNodes(9).Text 'Direction
   Cells(5, i).Value = Weather.ChildNodes(1).Text & " C"  'observation time

Next Weather

End Sub

```

Feel free to point out any poor coding and tips on how to improve it. I am currently using the Worksheet Activate sub to activate changes in the tables and get new data, but I suspect that is not the best solution. I am just not sure how else to do it seeing as I want it to be as "automatic" as possible, and use as few buttons to refresh as I can.