Option Explicit
'ADD RECORD
Sub AddRecordToTable()
Dim ws As Worksheet
Dim newRow As ListRow
Set ws = ActiveSheet
With ws.ListObjects("data")
.ListColumns("1").DataBodyRange.ClearContents
Set newRow = .ListRows.Add(1)
newRow.Range(.ListColumns("1").Index) = "1"
newRow.Range(.ListColumns("Status").Index) = "PENDING"
End With
End Sub
'SELECT TABLE ROW
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tbl As ListObject
Dim rngCell As Range
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
Set tbl = Target.Worksheet.ListObjects(1)
If tbl Is Nothing Then Exit Sub
If tbl.ListRows.Count = 0 Then Exit Sub
Set rngCell = Application.Intersect(tbl.ListColumns("1").DataBodyRange, Target)
If rngCell Is Nothing Then Exit Sub
On Error GoTo 0
tbl.ListColumns("1").DataBodyRange = ""
rngCell.Value = 1
Dim SelectRow As Long
'Must preceed next Sub
Sub Undo_()
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
End Sub
'SOLD STATUS CHANGES ALL ROW TO VALUES
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim rngCol1 As Range
Dim rng2 As Range
Dim lo As ListObject
Dim lColCnt As Long
Dim i As Long
Dim v As Variant
Set lo = Me.ListObjects(1)
lColCnt = lo.ListColumns.Count
Set rngCol1 = Intersect(Target, lo.Range.Columns(4))
If Not rngCol1 Is Nothing Then
With Application
.EnableEvents = False
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
ReDim v(1 To lColCnt)
For Each rng In rngCol1
If LCase(rng.Value) = LCase("SOLD") Then
i = 0
'Added code
Dim Answer As VbMsgBoxResult
Answer = MsgBox("This will clear all formulas in this row", vbYesNo + vbExclamation + vbDefaultButton2, "CONFIRM SOLD?")
If Answer = vbNo Then
Call Undo_
Exit Sub
End If
'Remember the numerical formats of each column
For Each rng2 In lo.ListRows(rng.Row - lo.Range.Row).Range
i = i + 1
v(i) = rng2.NumberFormat
Next rng2
'Paste values
rng.Resize(, lColCnt).Value = rng.Resize(, lColCnt).Value
'Restore original formats of each column
For i = 1 To lColCnt
lo.ListRows(rng.Row - lo.Range.Row).Range.Cells(1).Offset(, i - 1).NumberFormat = v(i)
Next i
End If
Next rng
'SortMASTER
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End If
End Sub
''DELETE ROW
Sub DeleteRow()
Dim question As String
Dim dataTable As ListObject
Dim ws As Worksheet
Dim i As Long
Dim rowsToDelete As Range
Set rowsToDelete = Nothing
' Assuming you want to work with the active sheet
Set ws = ActiveSheet
' NAME OF TABLE
Set dataTable = ws.ListObjects("data")
Application.ScreenUpdating = False
Set lo = Me.ListObjects(1)
lColCnt = lo.ListColumns.Count
'Added block -->
Set rngCol1 = Intersect(Target.Cells(1, 1), lo.Range.Columns(1))
If Not rngCol1 Is Nothing Then
If rngCol1.Cells(1, 1).Value = 1 Then
Me.BUTTON_01.Visible = True
Else
Me.BUTTON_01.Visible = False
End If
End If
'<-- End Added Block
Set rngCol1 = Intersect(Target, lo.Range.Columns(4))
If Not rngCol1 Is Nothing Then
With Application
' Loop through each row in the table
For i = dataTable.ListRows.Count To 1 Step -1 ' Looping backwards to avoid issues with deleting rows
' Check if the value in column "1" of the current row is 1
If dataTable.DataBodyRange.Cells(i, dataTable.ListColumns("1").Index).Value = 1 Then
' Add the entire row to the range to be deleted
If rowsToDelete Is Nothing Then
Set rowsToDelete = dataTable.ListRows(i).Range
Else
Set rowsToDelete = Union(rowsToDelete, dataTable.ListRows(i).Range)
End If
End If
Next i
' Prompt the user to confirm deletion
If Not rowsToDelete Is Nothing Then
question = "Are you sure?"
If MsgBox(question, vbOKCancel + vbCritical + vbDefaultButton2, "DELETE RECORD") = vbOK Then
' Delete all rows at once
rowsToDelete.Delete
End If
End If
Application.ScreenUpdating = True
End Sub
