(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.

 

[aRandomHelper]

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.

Do you mean delete rows 4 : 18 if textbox1 date is 26-01-21?

 

[kelly mort]

Do you mean delete rows 4 : 18 if textbox1 date is 26-01-21?

Exactly.

Then when the date is 27-01-21, I want to delete rows 19:32 and so on

 

[aRandomHelper]

Please try on a copy of your worksheet

Sub me1159752_delete()
    Dim i As Long, j As Long, d As Long
    With Sheets("Sheet1") '<-- change sheet name
        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 = CLng(TextBox1.Value) Then ' <-- may need tweaking for the date comparison
                For j = i + 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
                    If .Cells(j, 1).Value = "" Or .Cells(j, 1).Value2 = d + 1 Then  ' loops until the next day's date or until a blank cell
                        .Rows(i).Resize(j - i).Delete xlUp
                        Exit Sub
                    End If
                Next
            End If
        Next
    End With
End Sub

 

[kelly mort]

Hi, @aRandomHelper,

This is the code that is loading the combobox that habours my dates (TextBox1) as used in your code.

This makes the dates appear as "26-Jan-21" inside the combobox.

Sub LoadDates()
    Dim e 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
    With CreateObject("Scripting.dictionary")
        For Each e In EXP.Range("A4:A" & lr).Cells
            If IsDate(e) Then .item(e.Value) = Empty
        Next e
        cboGetDate.Clear
        cboGetDate.List = .keys
    End With
End Sub

And when I run the code, I get a type mismatch error on this line:

If d = CLng(TextBox1.Value) Then

 

[aRandomHelper]

Try this amended code

Sub me1159752_delete()
    Dim i As Long, j As Long, d As Long, d2
    d2 = Split(cboGetDate.Value, "-")
    d2 = 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).Value2 = d + 1 Then
                        .Rows(i).Resize(j - i).Delete xlUp
                        Exit Sub
                    End If
                Next
            End If
        Next
    End With
End Sub

 

[kelly mort]

I am getting same error.
I tried doing this:

d2 = Split(Format(cboGetDate.Value,"dd-mm-yy"), "-")

and the error went away but it never deleted the rows.

 

[aRandomHelper]

Can you step through, or run this and see what's printed by the Debug.print in the immediate window?

Sub me1159752_delete()
    Dim i As Long, j As Long, d As Long, d2
    Debug.print cboGetDate.Value
    d2 = Split(Format(cboGetDate.Value,"dd-mm-yy"), "-")
    d2 = DateSerial(d2(2), d2(1), d2(0))
    Debug.print d2
    d2 = CLng(d2)
    Debug.print d2
    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).Value2 = d + 1 Then
                        .Rows(i).Resize(j - i).Delete xlUp
                        Exit Sub
                    End If
                Next
            End If
        Next
    End With
End Sub

 

[kelly mort]

27-Jan-21
27-Jan-21 
 44223

This is what the immediate window is producing

 

[aRandomHelper]

How about this? Theoretically the same as previous code; did it do anything the last time?

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).Value2 = d + 1 Then
                        .Rows(i).Resize(j - i).Delete xlUp
                        Exit Sub
                    End If
                Next
            End If
        Next
    End With
End Sub