Shorten the code so it doesn't look like 8yo wrote it

I

imag1ne

New Member
Joined
Apr 6, 2014
Messages
44
Hi, All.

A bit unusual question. The code below works and does what it needs to do, but I just don't like to repeat same code over and over again, is there any suggestions, how to get some bits shorter (in function, separate routine). As only thing changes is the "If" statement and variable in each case. Haven't found a way to pass whole "If" statement to a function.

Thank You for answers.

Code: 
Dim strMyPath As String, strDBName As String, strDB As String, sql As String, cbv As String, t As String, t2 As String
Dim daoDB As DAO.Database
Dim recSet As DAO.Recordset
Dim i As Long


    cbv = cb_time.Value


lb_lines.Clear


    strDBName = "Database.mdb"
    strMyPath = ThisWorkbook.Path
    strDB = strMyPath & "\" & strDBName
    Set daoDB = DBEngine.Workspaces(0).OpenDatabase(strDB)
    sql = "SELECT * FROM NLD WHERE Released=False"
    Set recSet = daoDB.OpenRecordset(sql, dbOpenDynaset)
    i = 0
    
recSet.MoveLast
recSet.MoveFirst


Select Case cbv
    Case Is = "Any Time"
        Do While Not recSet.EOF
            With lb_lines
                .AddItem
                .List(i, 0) = recSet("ItemCode").Value
                .List(i, 1) = recSet("Description").Value
                .List(i, 2) = recSet("Supplier").Value
                .List(i, 3) = Left(recSet("TimeAdded").Value, 10)
                .List(i, 4) = recSet("AddedBy").Value
            End With
                i = i + 1
            recSet.MoveNext
        Loop
        
    Case Is = "This Year"
        t = Year(Date)
        Do While Not recSet.EOF
[COLOR=#0000cd][B]            If Mid(recSet("TimeAdded").Value, 7, 4) = t Then[/B][/COLOR]
                With lb_lines
                    .AddItem
                    .List(i, 0) = recSet("ItemCode").Value
                    .List(i, 1) = recSet("Description").Value
                    .List(i, 2) = recSet("Supplier").Value
                    .List(i, 3) = Left(recSet("TimeAdded").Value, 10)
                    .List(i, 4) = recSet("AddedBy").Value
                End With
                i = i + 1
            End If
            recSet.MoveNext
        Loop


    Case Is = "Last 6 Months"
        t = Format(DateAdd("m", -6, Date), "mm/yyyy")
        Do While Not recSet.EOF
[B][COLOR=#0000cd]            If Mid(recSet("TimeAdded").Value, 4, 7) >= t Then[/COLOR][/B]
                With lb_lines
                    .AddItem
                    .List(i, 0) = recSet("ItemCode").Value
                    .List(i, 1) = recSet("Description").Value
                    .List(i, 2) = recSet("Supplier").Value
                    .List(i, 3) = Left(recSet("TimeAdded").Value, 10)
                    .List(i, 4) = recSet("AddedBy").Value
                End With
                i = i + 1
            End If
            recSet.MoveNext
        Loop
        
    Case Is = "Last 3 Months"
        t = Format(DateAdd("m", -3, Date), "mm/yyyy")
        Do While Not recSet.EOF
[COLOR=#0000cd][B]            If Mid(recSet("TimeAdded").Value, 4, 7) >= t Then[/B][/COLOR]
                With lb_lines
                    .AddItem
                    .List(i, 0) = recSet("ItemCode").Value
                    .List(i, 1) = recSet("Description").Value
                    .List(i, 2) = recSet("Supplier").Value
                    .List(i, 3) = Left(recSet("TimeAdded").Value, 10)
                    .List(i, 4) = recSet("AddedBy").Value
                End With
                i = i + 1
            End If
            recSet.MoveNext
        Loop


    Case Is = "This Month"
        t = Format(Date, "mm/yyyy")
        Do While Not recSet.EOF
[B][COLOR=#0000cd]            If Mid(recSet("TimeAdded").Value, 4, 7) = t Then[/COLOR][/B]
                With lb_lines
                    .AddItem
                    .List(i, 0) = recSet("ItemCode").Value
                    .List(i, 1) = recSet("Description").Value
                    .List(i, 2) = recSet("Supplier").Value
                    .List(i, 3) = Left(recSet("TimeAdded").Value, 10)
                    .List(i, 4) = recSet("AddedBy").Value
                End With
                i = i + 1
            End If
            recSet.MoveNext
        Loop
        
    Case Is = "This Week"
        t = Format(Date, "ww")
        Do While Not recSet.EOF
[B][COLOR=#0000cd]            If Format(Mid(recSet("TimeAdded").Value, 1, 10), "ww") = t Then[/COLOR][/B]
                With lb_lines
                    .AddItem
                    .List(i, 0) = recSet("ItemCode").Value
                    .List(i, 1) = recSet("Description").Value
                    .List(i, 2) = recSet("Supplier").Value
                    .List(i, 3) = Left(recSet("TimeAdded").Value, 10)
                    .List(i, 4) = recSet("AddedBy").Value
                End With
                i = i + 1
            End If
            recSet.MoveNext
        Loop
        
    Case Is = "Yesterday"
        t = DateAdd("d", -1, Format(Date, "dd/mm/yyyy"))
        Do While Not recSet.EOF
[B][COLOR=#0000cd]            If Mid(recSet("TimeAdded").Value, 1, 10) = t Then[/COLOR][/B]
                With lb_lines
                    .AddItem
                    .List(i, 0) = recSet("ItemCode").Value
                    .List(i, 1) = recSet("Description").Value
                    .List(i, 2) = recSet("Supplier").Value
                    .List(i, 3) = Left(recSet("TimeAdded").Value, 10)
                    .List(i, 4) = recSet("AddedBy").Value
                End With
                i = i + 1
            End If
            recSet.MoveNext
        Loop
        
    Case Is = "Today"
        t = Format(Date, "dd/mm/yyyy")
        Do While Not recSet.EOF
[COLOR=#0000cd][B]            If Mid(recSet("TimeAdded").Value, 1, 10) = t Then[/B][/COLOR]
                With lb_lines
                    .AddItem
                    .List(i, 0) = recSet("ItemCode").Value
                    .List(i, 1) = recSet("Description").Value
                    .List(i, 2) = recSet("Supplier").Value
                    .List(i, 3) = Left(recSet("TimeAdded").Value, 10)
                    .List(i, 4) = recSet("AddedBy").Value
                End With
                i = i + 1
            End If
            recSet.MoveNext
        Loop
        
    Case Is = "Last 2h"
        t = Format(Date, "dd/mm/yyyy")
        t2 = Format(Now - TimeValue("02:00:00"), "h")
        Do While Not recSet.EOF
[COLOR=#0000cd][B]            If Mid(recSet("TimeAdded").Value, 1, 10) = t And Format(recSet("TimeAdded").Value, "h") >= t2 Then[/B][/COLOR]
                With lb_lines
                    .AddItem
                    .List(i, 0) = recSet("ItemCode").Value
                    .List(i, 1) = recSet("Description").Value
                    .List(i, 2) = recSet("Supplier").Value
                    .List(i, 3) = Left(recSet("TimeAdded").Value, 10)
                    .List(i, 4) = recSet("AddedBy").Value
                End With
                i = i + 1
            End If
            recSet.MoveNext
        Loop
        
End Select
 
Last edited:

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
Your code looks OK to me. From a maintenance point of view, it is better to have simple and obvious code rather than elegant and 'clever' code.

The only change I would make is to put the With lb_lines ... End With block in a separate routine, since the same code is used for each case (I assume that lb_lines is a multi-column listbox).

Something like this:
Code: 
Private Sub Add_Listbox_Row(lb As MSForms.ListBox, thisRs As DAO.Recordset)
    With lb
        .AddItem
        .List(.ListCount - 1, 0) = thisRs("ItemCode").Value
        .List(.ListCount - 1, 1) = thisRs("Description").Value
        .List(.ListCount - 1, 2) = thisRs("Supplier").Value
        .List(.ListCount - 1, 3) = Left(thisRs("TimeAdded").Value, 10)
        .List(.ListCount - 1, 4) = thisRs("AddedBy").Value
    End With
End Function
and then each Case changes like this:
Code: 
    Case Is = "Any Time"
        Do While Not recSet.EOF
            Add_Listbox_Row lb_lines, recSet
            recSet.MoveNext
        Loop
I don't think you need the i variable as the listbox row index because you clear the listbox at the start and therefore can use .ListCount - 1 as the row index.
 
Upvote 0
John_w said:
Your code looks OK to me. From a maintenance point of view, it is better to have simple and obvious code rather than elegant and 'clever' code.

The only change I would make is to put the With lb_lines ... End With block in a separate routine, since the same code is used for each case (I assume that lb_lines is a multi-column listbox).

Something like this:
Code: 
Private Sub Add_Listbox_Row(lb As MSForms.ListBox, thisRs As DAO.Recordset)
    With lb
        .AddItem
        .List(.ListCount - 1, 0) = thisRs("ItemCode").Value
        .List(.ListCount - 1, 1) = thisRs("Description").Value
        .List(.ListCount - 1, 2) = thisRs("Supplier").Value
        .List(.ListCount - 1, 3) = Left(thisRs("TimeAdded").Value, 10)
        .List(.ListCount - 1, 4) = thisRs("AddedBy").Value
    End With
End Function
and then each Case changes like this:
Code: 
    Case Is = "Any Time"
        Do While Not recSet.EOF
            Add_Listbox_Row lb_lines, recSet
            recSet.MoveNext
        Loop
I don't think you need the i variable as the listbox row index because you clear the listbox at the start and therefore can use .ListCount - 1 as the row index.
Click to expand...


Exactly what I was looking for. :)

Was not sure how to pass recSet value, but that's now sorted.

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

Similar threads

M
  • Question Question
Excel: continuously log database data into cells
Replies
2
Views
435
mewingpants
M
I
  • Solved
If no values are found then show Msgbox
Replies
6
Views
98
ipbr21054
I
I
  • Solved
Edit working code to look for value after a date & before a date
Replies
6
Views
115
Alex Blakenburg
A
I
  • Question Question
Select Listbox value to be then taken to customer on worksheet
Replies
1
Views
104
ipbr21054
I
I
  • Question Question
Listbox columns dont alter when i set the width advice please
Replies
4
Views
44
ipbr21054
I

Forum statistics

Threads
1,223,907
Messages
6,175,300
Members
452,633
Latest member
DougMo

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