(VBA) Delete data from my database in a unique way

[kelly mort]

Using the above image as I guide, I need a script that can delete the records for a given date.

Since I am not sorting the database, I want to delete the entire row.

So say I target the date "26-01-21", then I want to delete the rows having that dates records including the row on which the date is found.

How the image appears above is exactly how my database look like except that those textbox names are not part.

Thanks in advance.

 

[kelly mort]

The last two codes run without error message but they fail to delete the rows.

 

[aRandomHelper]

It is looping through column A, are your data starting from column A, and the dates are also there?

 

[kelly mort]

To answer your question, Yes, the dates are also in column A.

I placed a few msgbox at various points to check whats actually going on.
It came out that both "Hi 1" and "Hi 2" showed multiple times while the third alert never showed.

d2 = Split(Format(cboGetDate.Value, "dd-mm-yy"), "-")
    d2 = CLng(DateSerial(d2(2), d2(1), d2(0)))
    With Sheets("EXPENSE")
        For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If IsDate(.Cells(i, 1).Value) Then d = CLng(.Cells(i, 1).Value2)
            If d = d2 Then
                
                MsgBox "Hi 1"
                For j = i + 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
                    
                    MsgBox "Hi 2"
                    If .Cells(j, 1).Value = "" Or .Cells(j, 1).Value2 = d + 1 Then
                        .Rows(i).Resize(j - i).Delete xlUp
                        
                        MsgBox "Hi 3"
                        Exit Sub
                    End If
                Next
            End If
        Next
    End With

 

[aRandomHelper]

I love debugging that way too. Would you have multiple rows with the same date? If not, try this, it loops until it sees a blank or another date (not limited to only the next date).

Sub me1159752_delete()
    Dim i As Long, j As Long, d As Long, d2
    d2 = Split(Format(cboGetDate.Value,"dd-mm-yy"), "-")
    d2 = CLng(DateSerial(d2(2), d2(1), d2(0)))
    With Sheets("EXPENSE")
        For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If IsDate(.Cells(i, 1).Value) Then d = CLng(.Cells(i, 1).Value2)
            If d = d2 Then
                For j = i + 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
                    If .Cells(j, 1).Value = "" Or IsDate(.Cells(j, 1).Value) Then
                        .Rows(i).Resize(j - i).Delete xlUp
                        Exit Sub
                    End If
                Next
            End If
        Next
    End With
End Sub

 

[kelly mort]

still it cannot delete.

Would you have multiple rows with the same date?

There will be only unique dates - no dupplicates

 

[aRandomHelper]

Probably one last shot I guess, before needing to see a real sample of the worksheet...

Sub me1159752_delete()
    Dim i As Long, j As Long, d As Long, d2
    d2 = Split(Format(cboGetDate.Value,"dd-mm-yy"), "-")
    d2 = CLng(DateSerial(d2(2), d2(1), d2(0)))
    With Sheets("EXPENSE")
        For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If IsDate(.Cells(i, 1).Value) Then d = CLng(.Cells(i, 1).Value2)
            If d = d2 Then
                For j = i + 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
                    If .Cells(j, 1).Value = "" Or .Cells(j, 1).Text Like "##-##-##" Then 'assuming your dates are shown/formatted as dd-mm-yy
                        .Rows(i).Resize(j - i).Delete xlUp
                        Exit Sub
                    End If
                Next
            End If
        Next
    End With
End Sub

 

[kelly mort]

This is the link to the file:

SAMPLE_WORKBOOK.xlsm

Shared with Dropbox

www.dropbox.com

This code down here is what i am using to fetch data from the database back into the various boxes.
I tested it on only a single date entry but as I added extra dates, I noticed that my logical arguments were a bit out of bounds.

        Dim findvalue As Range, lr&, j&
        Dim EXP As Worksheet, c&, i&
        
        Set EXP = Sheets("EXPENSE")
           
        lr = EXP.Cells(Rows.Count, "A").End(xlUp).Row
        If lr < 4 Then lr = 4
        Set findvalue = EXP.Range("A4:A" & lr).Find(what:=CDate(cboGetDate), LookIn:=xlValues, lookat:=xlWhole)
        exp1 = findvalue.Text
        c = 2
        For i = 1 To Application.CountA(EXP.Range("A4:A" & lr)) - 2 '15
            For j = 0 To 1
                Me.Controls("exp" & c + j) = findvalue.Offset(i, j)
            Next j
            c = c + 2
        Next i

This line:

For i = 1 To Application.CountA(EXP.Range("A4:A" & lr)) - 2 '15

Instead of counting the number of none blank cells then taking away 2 from it, I want to count from the

 findvalue

variable (cell) until I meet the cell containing "DAILY TOTALS" then subtract the two from it.

My goal is just to be able to get the data back into the controls the right way. Thanks

 

[aRandomHelper]

I assume the deletion works on your side now?

Try this new code for your date box change

Private Sub cboGetDate_Change()
    If Len(cboGetDate) Then
        Dim findvalue As Range, lr&, j&
        Dim EXP As Worksheet, c&, i&
        
        Set EXP = Sheets("EXPENSE")
           
        lr = EXP.Cells(Rows.Count, "A").End(xlUp).Row
        If lr < 4 Then lr = 4
        Set findvalue = EXP.Range("A4:A" & lr).Find(what:=CDate(cboGetDate), LookIn:=xlValues, lookat:=xlWhole)
        exp1 = findvalue.Text
        c = 2
        'reset boxes and form height
        For i = 2 To 31
            Me.Controls("exp" & i) = ""
            If i > 3 Then Me.Controls("exp" & i).Visible = False
        Next i
        Me.Height = 141
        
        For i = findvalue.Row + 1 To EXP.Range("A4:A" & lr).Find(what:="DAILY TOTALS", LookIn:=xlValues, lookat:=xlWhole, after:=findvalue).Row - 1 '15
            If Not IsDate(EXP.Cells(i, 1).Value) Then
                For j = 0 To 1
                    Me.Controls("exp" & c + j) = EXP.Cells(i, j + 1).Value
                Next j
                c = c + 2
            Else
                Exit For
            End If
        Next i
        
        For i = 3 To 31 Step 2
            Controls("exp" & i) = Format(Controls("exp" & i), "0.00")
        Next i
    End If
    
    exp1.Enabled = False
    cmd_exp_add.Enabled = False
    Me.cmdDelete.Enabled = True
    Me.cmdEdit.Enabled = True
    Me.eBack.Enabled = True
    Me.eNext.Enabled = True
End Sub

 

[kelly mort]

The "cboGetDate_Change" Event code that you supplied worked very great - that part of problem is solved now.

And that gave me the opportunity to truly test your delete codes.

I am currently using the last code you supplied before I uploaded the sample workbook.

The code is deleting the rows except when there is only one date in the system.

 

[aRandomHelper]

This should fix it now:

    With EXP
        For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If IsDate(.Cells(i, 1).Value) Then d = CLng(.Cells(i, 1).Value2)
            If d = d2 Then
                For j = i + 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
                    If .Cells(j, 1).Value = "" Or .Cells(j, 1).Text Like "##-##-##" Then 'assuming your dates are shown/formatted as dd-mm-yy
                        .Rows(i).Resize(j - i).Delete xlUp
                        Exit Sub
                    End If
                    If j = .Cells(.Rows.Count, 1).End(xlUp).Row Then
                        .Rows(i).Resize(j - i + 1).Delete xlUp
                        Exit Sub
                    End If
                Next
            End If
        Next
    End With