VBA code need help

[artilheirogomes]

Hello Excel masters

I need some assistance. Currently i have a database where i need to keep track of the times spent between tasks. My current issue with the code is:

Every time that is inserted a value into the cell "F2" on excel it should be inserted into the tab "Rack SN" (see attachments for the file).
- If is the same value, then should be placed on the next empty row the same value
- If is different value should create another table to track the tasks for another RackSN

Is someone that can help me with this?

This is the code i use at the moment but is not complete, i got stock on the filtering SN and insert into cells:

Sub AddRecordToTable()

Dim ws As Worksheet
Dim newcolumn As ListColumn
Dim rownum As Integer
Dim columnnum As Integer
Dim racksn As Integer

Dim sn_tempnew As Integer
Dim sn_tempold As Integer


Set ws = ActiveSheet
Set newrow = ws.ListObjects("NewRack").ListRows.Add


'insert new table if different Rack SN


'insert full table

    With newrow

    'table
        .Range(1, 1) = "Details"
        .Range(1, 2) = "Rack SN"
        .Range(1, 3) = "Time"
        .Range(1, 4) = "Time taken"
        .Range(1, 5) = "Total time"
        .Range(2, 1) = "Start"
        .Range(3, 1) = "RackScan"
        .Range(4, 1) = "Screws"
        .Range(5, 1) = "Cabeling"
        .Range(6, 1) = "Physical damage"
        .Range(7, 1) = "Management"
    'merged cells
    '    .Range(2, 5).Merge
    '    .Range(3, 5).Merge
    '    .Range(4, 5).Merge
    '    .Range(5, 5).Merge
    '    .Range(6, 5).Merge
    '    .Range(7, 5).Merge
    '    Worksheets("Sheet1").Range("E2:E7").HorizontalAlignment = xlCenter
    '    Worksheets("Sheet1").Range("E2:E7").VerticalAlignment = xlCenter
    End With


'insert timestamp into cells

    Select Case Cells(2, 3).Value
        Case False
            Cells(2, 3).ClearContents
        Case True
            Cells(2, 3).Value = "=Timestamp(B)"
    End Select

    Select Case Cells(3, 3).Value
        Case False
            Cells(3, 3).ClearContents
        Case True
            Cells(3, 3).Value = "=Timestamp(B)"
    End Select
   
    Select Case Cells(4, 3).Value
        Case False
            Cells(4, 3).ClearContents
        Case True
            Cells(4, 3).Value = "=Timestamp(B)"
    End Select
   
    Select Case Cells(5, 3).Value
        Case False
            Cells(5, 3).ClearContents
        Case True
            Cells(5, 3).Value = "=Timestamp(B)"
    End Select

    Select Case Cells(6, 3).Value
        Case False
            Cells(6, 3).ClearContents
        Case True
            Cells(6, 3).Value = "=Timestamp(B)"
    End Select
   
    Select Case Cells(7, 3).Value
        Case False
            Cells(7, 3).ClearContents
        Case True
            Cells(7, 3).Value = "=Timestamp(B)"
    End Select
   

'insert time difference calculator

    Select Case Cells(3, 4).Value
        Case False
            Cells(3, 4).ClearContents
        Case True
            Cells(3, 4).Value = "=IFERROR(C-(C-1),"")"
    End Select
   
    Select Case Cells(4, 4).Value
        Case False
            Cells(4, 4).ClearContents
        Case True
            Cells(4, 4).Value = "=IFERROR(C-(C-1),"")"
    End Select
   
    Select Case Cells(5, 4).Value
        Case False
            Cells(5, 4).ClearContents
        Case True
            Cells(5, 4).Value = "=IFERROR(C-(C-1),"")"
    End Select

    Select Case Cells(6, 4).Value
        Case False
            Cells(6, 4).ClearContents
        Case True
            Cells(6, 4).Value = "=IFERROR(C-(C-1),"")"
    End Select
   
    Select Case Cells(7, 4).Value
        Case False
            Cells(7, 4).ClearContents
        Case True
            Cells(7, 4).Value = "=IFERROR(C-(C-1),"")"
    End Select


'Insert the total time taken for tasks


'Insert data into next empty cell
   
   
   
End Sub

 

[kanadaaa]

Reflected your demand and fixed a bug:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rwForNewTable As Long, SF As String, valSF As String, fnd As Range

    SF = "F2" 'Cell address of scan field
  
    If Not Intersect(Target, Range(SF)) Is Nothing And Range(SF) <> "" Then 'if scan field is changed and not blank
  
        Application.ScreenUpdating = False
      
        valSF = Range(SF)
        Range(SF) = ""
        Set fnd = Range("B:B").Find(valSF, LookAt:=xlWhole, SearchDirection:=xlPrevious)
      
        If Not fnd Is Nothing Then 'If the SN typed in is in an existing table
      
            If fnd.Offset(, -1) <> "Management" Then 'If the destination table is not fully filled
          
                fnd.Offset(1) = valSF 'Transfer scan field value
                fnd.Offset(1, 1) = Timestamp(fnd.Offset(1)) 'Input timestamp
              
            Else 'If the destination table is fully filled
          
                rwForNewTable = Cells(Rows.Count, "A").End(xlUp).Row + 2 'Get row for new table
                Range("A1").Resize(7, 5).Copy Cells(rwForNewTable, "A") 'Insert new table
                Cells(rwForNewTable, "A").Offset(1, 1).Resize(6, 2).ClearContents 'Clear data in the new table
                Cells(rwForNewTable, "A").Offset(1, 1) = valSF 'Transfer scan field value
                Cells(rwForNewTable, "A").Offset(1, 2) = Timestamp(Cells(rwForNewTable, "A").Offset(1, 1)) 'Input timestamp
              
            End If
          
        Else 'If the SN typed in is not in the existing tables
      
            If Cells(2, "B") = "" Then 'If the target cell is the first cell of the first table
          
                Cells(2, "B") = valSF 'Transfer scan field value
                Cells(2, "C") = Timestamp(Cells(2, "B")) 'Input timestamp
          
            Else
      
                rwForNewTable = Cells(Rows.Count, "A").End(xlUp).Row + 2 'Get row for new table
                Range("A1").Resize(7, 5).Copy Cells(rwForNewTable, "A") 'Insert new table
                Cells(rwForNewTable, "A").Offset(1, 1).Resize(6, 2).ClearContents 'Clear data in the new table
                Cells(rwForNewTable, "A").Offset(1, 1) = valSF 'Transfer scan field value
                Cells(rwForNewTable, "A").Offset(1, 2) = Timestamp(Cells(rwForNewTable, "A").Offset(1, 1)) 'Input timestamp
              
            End If
          
        End If
      
        Range(SF).Select 'Return focus to F2
        Application.ScreenUpdating = True
      
    End If
      
End Sub

And if you need a copy of my test workbook, download it from here: https://easyupload.io/0uxtw1

 

[artilheirogomes]

Oh right, it's funny I didn't understand your demand correctly.
That's pretty easy. Give me a moment, I'll modify the code.

is the code modified?

 

[artilheirogomes]

Reflected your demand and fixed a bug:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rwForNewTable As Long, SF As String, valSF As String, fnd As Range

    SF = "F2" 'Cell address of scan field
 
    If Not Intersect(Target, Range(SF)) Is Nothing And Range(SF) <> "" Then 'if scan field is changed and not blank
 
        Application.ScreenUpdating = False
     
        valSF = Range(SF)
        Range(SF) = ""
        Set fnd = Range("B:B").Find(valSF, LookAt:=xlWhole, SearchDirection:=xlPrevious)
     
        If Not fnd Is Nothing Then 'If the SN typed in is in an existing table
     
            If fnd.Offset(, -1) <> "Management" Then 'If the destination table is not fully filled
         
                fnd.Offset(1) = valSF 'Transfer scan field value
                fnd.Offset(1, 1) = Timestamp(fnd.Offset(1)) 'Input timestamp
             
            Else 'If the destination table is fully filled
         
                rwForNewTable = Cells(Rows.Count, "A").End(xlUp).Row + 2 'Get row for new table
                Range("A1").Resize(7, 5).Copy Cells(rwForNewTable, "A") 'Insert new table
                Cells(rwForNewTable, "A").Offset(1, 1).Resize(6, 2).ClearContents 'Clear data in the new table
                Cells(rwForNewTable, "A").Offset(1, 1) = valSF 'Transfer scan field value
                Cells(rwForNewTable, "A").Offset(1, 2) = Timestamp(Cells(rwForNewTable, "A").Offset(1, 1)) 'Input timestamp
             
            End If
         
        Else 'If the SN typed in is not in the existing tables
     
            If Cells(2, "B") = "" Then 'If the target cell is the first cell of the first table
         
                Cells(2, "B") = valSF 'Transfer scan field value
                Cells(2, "C") = Timestamp(Cells(2, "B")) 'Input timestamp
         
            Else
     
                rwForNewTable = Cells(Rows.Count, "A").End(xlUp).Row + 2 'Get row for new table
                Range("A1").Resize(7, 5).Copy Cells(rwForNewTable, "A") 'Insert new table
                Cells(rwForNewTable, "A").Offset(1, 1).Resize(6, 2).ClearContents 'Clear data in the new table
                Cells(rwForNewTable, "A").Offset(1, 1) = valSF 'Transfer scan field value
                Cells(rwForNewTable, "A").Offset(1, 2) = Timestamp(Cells(rwForNewTable, "A").Offset(1, 1)) 'Input timestamp
             
            End If
         
        End If
     
        Range(SF).Select 'Return focus to F2
        Application.ScreenUpdating = True
     
    End If
     
End Sub

And if you need a copy of my test workbook, download it from here: https://easyupload.io/0uxtw1

That is perfect.

Thank you very much for your help.