VBA code need help

artilheirogomes

New Member
Joined
Mar 18, 2021
Messages
22
Office Version
  1. 365
Platform
  1. Windows
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:

VBA Code:
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
 

Attachments

  • template.PNG
    template.PNG
    9.7 KB · Views: 9
Last edited by a moderator:

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
I have some clarification questions.
If a value is entered into F2, it is copied into a cell in column B (into B2 if it's blank, into B3 if B2 is filled and B3 is blank, etc.), and if B7 is filled, create a new table that looks identical.
If the value 3 is transferred into B2 but then the value 2 is transferred into B3, stop updating the table and create a new one that looks identical.
Is this what you want?
 
Upvote 0
I have some clarification questions.
If a value is entered into F2, it is copied into a cell in column B (into B2 if it's blank, into B3 if B2 is filled and B3 is blank, etc.), and if B7 is filled, create a new table that looks identical.
If the value 3 is transferred into B2 but then the value 2 is transferred into B3, stop updating the table and create a new one that looks identical.
Is this what you want?
Hello,

Yes, that is what i want to do. I believe is not so hard but my knowledge of vba is still not much advanced,
 
Upvote 0
Do you have a formula in E2?
If you do, please share the formula in it.
 
Upvote 0
On the cell E2 no, Just on E3, E4 to E7, as total time spent in the column D.

On the column D i have a time stamp to calculate the time difference between tests with the following code

Function Timestamp(Reference As Range)
If Reference.Value <> "" Then
Timestamp = Format(Now, "hh:mm:ss")
Else
Timestamp = ""
End If
End Function
 
Upvote 0
First, copy and paste the formula below into D3:
Excel Formula:
=IF(C3<>"",TEXT(C3-C2,"hh:mm:ss"),"")
Then drag D3 down to D7.

Then, copy and paste the formula below into E2:
Excel Formula:
=IFERROR(TEXT(LOOKUP(3,1/(C2:C7<>""),C2:C7)-C2,"hh:mm:ss"),"00:00:00")

Now you're all set.
Try the code below in the sheet module:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lrInTable As Long, inputRow As Long, rwForNewTable As Long
    Dim SF As String, valSF As String
    
    lrInTable = Cells(Rows.Count, "A").End(xlUp).Row '7,15,23 etc.
    SF = Cells(lrInTable - 5, "F").Address(0, 0) 'Cell address of scan field: F2, F10...
    
    If Not Intersect(Target, Range(SF)) Is Nothing And Range(SF) <> "" Then 'if scan field in F2, F10... is changed and not blank
    
        Application.ScreenUpdating = False
        
        valSF = Range(SF)
        Range(SF) = ""
        inputRow = Cells(Rows.Count, "B").End(xlUp).Row + 1
        rwForNewTable = Cells(Rows.Count, "A").End(xlUp).Row + 2
        
        Cells(inputRow, "B") = valSF 'Transfer scan field value
        Cells(inputRow, "C") = Timestamp(Cells(inputRow, "B")) 'Input timestamp
        
        If (Cells(inputRow, "B").Offset(-1) <> "Rack SN" And Cells(inputRow, "B") <> Cells(inputRow, "B").Offset(-1)) Or _
            Cells(lrInTable, "B") <> "" Then 'If different scan field is transferred OR If last row of the table is filled
            
            Cells(lrInTable, "A").Offset(-6).Resize(7, 6).Copy Cells(rwForNewTable, "A") 'Create new table
            Cells(rwForNewTable + 1, "B").Resize(6, 2).ClearContents 'Clear new table
            Range(SF).Offset(-1).Resize(2).ClearContents 'Clear scan field for the old table
            
        End If
        
        Application.ScreenUpdating = True
        
    End If
End Sub
 
Upvote 0
First, copy and paste the formula below into D3:
Excel Formula:
=IF(C3<>"",TEXT(C3-C2,"hh:mm:ss"),"")
Then drag D3 down to D7.

Then, copy and paste the formula below into E2:
Excel Formula:
=IFERROR(TEXT(LOOKUP(3,1/(C2:C7<>""),C2:C7)-C2,"hh:mm:ss"),"00:00:00")

Now you're all set.
Try the code below in the sheet module:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lrInTable As Long, inputRow As Long, rwForNewTable As Long
    Dim SF As String, valSF As String
   
    lrInTable = Cells(Rows.Count, "A").End(xlUp).Row '7,15,23 etc.
    SF = Cells(lrInTable - 5, "F").Address(0, 0) 'Cell address of scan field: F2, F10...
   
    If Not Intersect(Target, Range(SF)) Is Nothing And Range(SF) <> "" Then 'if scan field in F2, F10... is changed and not blank
   
        Application.ScreenUpdating = False
       
        valSF = Range(SF)
        Range(SF) = ""
        inputRow = Cells(Rows.Count, "B").End(xlUp).Row + 1
        rwForNewTable = Cells(Rows.Count, "A").End(xlUp).Row + 2
       
        Cells(inputRow, "B") = valSF 'Transfer scan field value
        Cells(inputRow, "C") = Timestamp(Cells(inputRow, "B")) 'Input timestamp
       
        If (Cells(inputRow, "B").Offset(-1) <> "Rack SN" And Cells(inputRow, "B") <> Cells(inputRow, "B").Offset(-1)) Or _
            Cells(lrInTable, "B") <> "" Then 'If different scan field is transferred OR If last row of the table is filled
           
            Cells(lrInTable, "A").Offset(-6).Resize(7, 6).Copy Cells(rwForNewTable, "A") 'Create new table
            Cells(rwForNewTable + 1, "B").Resize(6, 2).ClearContents 'Clear new table
            Range(SF).Offset(-1).Resize(2).ClearContents 'Clear scan field for the old table
           
        End If
       
        Application.ScreenUpdating = True
       
    End If
End Sub
Hello,

I tried the advice given, but i think i am not doing something correct it does not work properly.

I attached the file for a better assistance.

1616575120004.png


The basic idea is to scan more than on "Rack" with different serial numbers and if does not match any previous value inserts a new table, if is included in previous tables then it inserts the SN in the last empty line from the designated table

I appreciate your help upfront
 
Upvote 0
Hi, I uploaded my test file here: https://easyupload.io/vedta9
Try this and see if it does the trick you want.

One clarification question:
With the code above, if you have values in column B as below...
1165384 Create new table based on cell value.xlsm
ABCDEF
1DetailsRack SNTimeTime takenTotal timeScan field
2Start217:55:1500:00:51
3RackScan217:56:0600:00:51
4Screws 
5Cabeling 
6Physical Damage 
7Management 
Sheet1

and if, say, 3 is typed into scan field, then you get this:
1165384 Create new table based on cell value.xlsm
ABCDEF
1DetailsRack SNTimeTime takenTotal time
2Start217:55:1500:03:22
3RackScan217:56:0600:00:51
4Screws317:58:3700:02:31
5Cabeling 
6Physical Damage 
7Management 
8
9DetailsRack SNTimeTime takenTotal timeScan field
10Start00:00:00
11RackScan 
12Screws 
13Cabeling 
14Physical Damage 
15Management 
Sheet1

Do you mean you need the 3 to be inserted into the new table?
Also, do you mean, if 2 is typed into scan field in the situation where you have the tables just in the image immediately above, you need it to be inserted into the first table?
 
Upvote 0
Hello,

Yes, if the 3 is scanned needs to be inserted in the new table, if 2 is scanned then just adds on the correspondent table from the 2 on the latest empty line
 
Upvote 0

Forum statistics

Threads
1,214,975
Messages
6,122,538
Members
449,088
Latest member
RandomExceller01

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