Keeping Date and Data in the same Row on a worksheet Using Vba

bugs63 · Aug 25th 2022

Is There a Way to keep the same Date and Data in the same row on a worksheet with this code below?. I am trying to update a Hourly Count Sheet and the end users of the form need to close the program and re-enter the data for the next hour. on a daily bases. Is this possible?. Thank You. I have included The Module in this code.

Code

Option Explicit


Private Sub cmdReset_Click()

Dim msgValue As VbMsgBoxResult
    
    msgValue = MsgBox("Do you want to Reset your counts", vbYesNo + vbInformation, "Hourly Space Counts")
    If msgValue = vbNo Then Exit Sub
    
    Call Reset


End Sub

Private Sub cmdSave_Click()
Dim msgValue As VbMsgBoxResult
    
    msgValue = MsgBox("Do you want to save your counts?", vbYesNo + vbInformation, "Hourly Space Counts")
    If msgValue = vbNo Then Exit Sub
    
    Call Submit
    


End Sub

Private Sub UserForm_Activate()

Dim C As Boolean
Do
If C = True Then Exit Sub
ClockTextBox = Format(Now, "HH:MM:SS")
DoEvents
Loop


End Sub

Private Sub UserForm_Initialize()

       lblDate1 = Format(Date, "mm/d/yyyy")
       lblDate2 = Format(Date, "mmmm d, yyyy")
       
       Call Reset
       
End Sub



"Module

Option Explicit


Sub Reset()

Dim iRow As Long
iRow = [CountA(Database!A:A)] 'idetifying the last row

With frmForm

    .txtRowNumber.Value = ""
    .lstDatabase.ColumnCount = 145
    .lstDatabase.ColumnHeads = True
    
    .lstDatabase.ColumnWidths = "125 ,91 ,91,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91 ,91,91,91,91,91,91"
    

  If iRow > 1 Then
    .lstDatabase.RowSource = "Database!A2: EO" & iRow
  Else
    .lstDatabase.RowSource = "Database!A2:EO2"
  End If
  
 End With
 
 End Sub
 
  Sub Submit()
 
 Dim sh As Worksheet
 Dim iRow As Long
 
 Set sh = ThisWorkbook.Sheets("Database")
     iRow = [CountA(Database!A:A)] + 1
 
        With sh
        .Cells(iRow, 2) = iRow - 1 'This Is The Dynamic Serial Number
        
        .Cells(iRow, 1) = frmForm.lblDate1.Value
        .Cells(iRow, 2) = frmForm.txt0000ABC.Value
        .Cells(iRow, 3) = frmForm.txt0000ConRac.Value
        .Cells(iRow, 4) = frmForm.txt0000P4.Value
        .Cells(iRow, 5) = frmForm.txt0000P6.Value
        .Cells(iRow, 6) = frmForm.txt0000Valet.Value
        .Cells(iRow, 7) = frmForm.txt0000LotF.Value
        .Cells(iRow, 8) = frmForm.txt0100ABC.Value
        .Cells(iRow, 9) = frmForm.txt0100ConRac.Value
        .Cells(iRow, 10) = frmForm.txt0100P4.Value
        .Cells(iRow, 11) = frmForm.txt0100P6.Value
        .Cells(iRow, 12) = frmForm.txt0100Valet.Value
        .Cells(iRow, 13) = frmForm.txt0100LotF.Value
        .Cells(iRow, 14) = frmForm.txt0200ABC.Value
        .Cells(iRow, 15) = frmForm.txt0200ConRac.Value
        .Cells(iRow, 16) = frmForm.txt0200P4.Value
        .Cells(iRow, 18) = frmForm.txt0200P6.Value
        .Cells(iRow, 17) = frmForm.txt0200Valet.Value
        .Cells(iRow, 18) = frmForm.txt0200LotF.Value
        .Cells(iRow, 19) = frmForm.txt0300ABC.Value
        .Cells(iRow, 20) = frmForm.txt0300ConRac.Value
        .Cells(iRow, 21) = frmForm.txt0300P4.Value
        .Cells(iRow, 22) = frmForm.txt0300P6.Value
        .Cells(iRow, 23) = frmForm.txt0300Valet.Value
        .Cells(iRow, 24) = frmForm.txt0300LotF.Value
        .Cells(iRow, 25) = frmForm.txt0400ABC.Value
        .Cells(iRow, 26) = frmForm.txt0400ConRac.Value
        .Cells(iRow, 27) = frmForm.txt0400P4.Value
        .Cells(iRow, 28) = frmForm.txt0400P6.Value
        .Cells(iRow, 29) = frmForm.txt0400Valet.Value
        .Cells(iRow, 30) = frmForm.txt0400LotF.Value
        .Cells(iRow, 31) = frmForm.txt0500ABC.Value
        .Cells(iRow, 32) = frmForm.txt0500ConRac.Value
        .Cells(iRow, 33) = frmForm.txt0500P4.Value
        .Cells(iRow, 34) = frmForm.txt0500P6.Value
        .Cells(iRow, 35) = frmForm.txt0500Valet.Value
        .Cells(iRow, 36) = frmForm.txt0500LotF.Value
        .Cells(iRow, 37) = frmForm.txt0600ABC.Value
        .Cells(iRow, 38) = frmForm.txt0600ConRac.Value
        .Cells(iRow, 39) = frmForm.txt0600P4.Value
        .Cells(iRow, 40) = frmForm.txt0600P6.Value
        .Cells(iRow, 41) = frmForm.txt0600Valet.Value
        .Cells(iRow, 42) = frmForm.txt0600LotF.Value
        .Cells(iRow, 43) = frmForm.txt0600ABC.Value
        .Cells(iRow, 44) = frmForm.txt0600ConRac.Value
        .Cells(iRow, 45) = frmForm.txt0600P4.Value
        .Cells(iRow, 46) = frmForm.txt0600P6.Value
        .Cells(iRow, 47) = frmForm.txt0600Valet.Value
        .Cells(iRow, 48) = frmForm.txt0600LotF.Value
        
        End With
        
End Sub
 
 Sub Show_From()
    frmForm.Show
 End Sub

Display More

bugs63 · Aug 26th 2022

Thank You

**pike** · Aug 27th 2022

Hi bugs63,

Can you attach the workbook as its not clear what you need to do.

Can you include a before and after example.

bugs63 · Aug 27th 2022

The Following is an image one using the VBA code provided. The second image is what is needed.

this was inputted into the worksheet directly or manually might be a better word to use. As you can see in both images every Column has a Header with the times for every lot , Military time is used, starting with 0000ABC to 0000LotF this is repeated every hour. The next hour of course would be 0100ABC to 0100LotF and so on until column EO that is the last column on the worksheet, starting at 2300ABC to 2300LotF, that ends the counting process until the next day.

**AliGW** · Aug 27th 2022

Attach a workbook, not a picture of it, please.

**KjBox** · Aug 27th 2022

You say "starting with 0000ABC to 0000LotF "

Your worksheet headers have a pattern of:

0000ABC 0000ConRac 0000P4 0000P6 0000LotF 0000Valet (LotF and Valet ARE NOT positioned as described)

But your submit code is filling the worksheet in the order:

0000ABC 0000ConRac 0000P4 0000P6 0000Valet 0000LotF (LotF and Valet ARE positioned as described)

Which is correct?

**KjBox** · Aug 27th 2022

Assuming that the order in your code is correct and the Worksheet Headers incorrect then try this code for your Submit Procedure (after correcting the Headers)

Code

Sub Submit()
    Dim x(1 To 24, 1 To 145), i&, ii&, lRow&, s$
    
    With Sheets("Database")
        lRow = .Cells(1).CurrentRegion.Rows.Count + 1
        For i = 1 To 144 Step 6
            ii = ii + 1
            s = IIf(s = "", "0000", Format(CLng(s) + 100, "0000"))
            x(ii, 1) = frmForm.lblDate1
            x(ii, i + 1) = frmForm.Controls("txt" & s & "ABC")
            x(ii, i + 2) = frmForm.Controls("txt" & s & "ConRac")
            x(ii, i + 3) = frmForm.Controls("txt" & s & "P4")
            x(ii, i + 4) = frmForm.Controls("txt" & s & "P6")
            x(ii, i + 5) = frmForm.Controls("txt" & s & "Valet")
            x(ii, i + 6) = frmForm.Controls("txt" & s & "LotF")
        Next
        .Cells(lRow, 1).Resize(24, 145) = x
        .Columns(1).Resize(, 145).AutoFit
    End With
        
End Sub

Display More

bugs63 · Aug 27th 2022

I do Not Know How to do that is it the same process as taking an image?.

**KjBox** · Aug 28th 2022

Have you tried the code I supplied in Post #7? What about the issue with your Header Row I asked about in Post #6?

To attach a workbook click "Attachments" at the bottom left of the Reply box (where you type a reply). Click the "Upload" button that appears, a pop-up window will appear, browse to and double click (or select it and click "Open"), the file that you want to upload. The file will then be attached to your reply.

bugs63 · Aug 28th 2022

No, I have not tried it yet I work the graveyard shift from 10 pm to 6 am so not yet as soon as I get some time I will try it and let you I have seen it. Thank you for the instruction on how to upload the workbook. I am doing it from a computer at work and it's telling me the file is too big. So I will Try it on my Computer at home.

Book 3.xlsm

**KjBox** · Aug 28th 2022

The file must be more than 3 MB, it is this site that rejects it (maximum upload file size accepted is 3 MB) not your PC.

You do not need to upload the whole file just the Database sheet (with header row only), the userform and all code in modules should suffice.

bugs63 · Aug 28th 2022

Ok trying it again

Book 3.xlsm

bugs63 · Aug 28th 2022

I just tried the code you gave me Thank You for that. It dose work but it repeats the date 24 times and it is starting in Row # 3 and not row #2. It's also going down the column, I need it to go from Left to Right as if you were reading a book with. Thank You again for your time.

**KjBox** · Aug 28th 2022

Try

Code

Sub Submit()
    Dim x(1 To 24, 1 To 145), i&, ii&, lRow&, s$
    
    With Sheets("Database")
        lRow = .Cells(1).CurrentRegion.Rows.Count + 1
        For i = 1 To 144 Step 6
            s = IIf(s = "", "0000", Format(CLng(s) + 100, "0000"))
            If frmForm.Controls("txt" & s & "ABC") <> vbNullString Then
                ii = ii + 1
                x(ii, 1) = frmForm.lblDate1
                x(ii, i + 1) = frmForm.Controls("txt" & s & "ABC")
                x(ii, i + 2) = frmForm.Controls("txt" & s & "ConRac")
                x(ii, i + 3) = frmForm.Controls("txt" & s & "P4")
                x(ii, i + 4) = frmForm.Controls("txt" & s & "P6")
                x(ii, i + 5) = frmForm.Controls("txt" & s & "Valet")
                x(ii, i + 6) = frmForm.Controls("txt" & s & "LotF")
            End If
        Next
        .Cells(lRow, 1).Resize(24, 145) = x
        .Columns(1).Resize(, 145).AutoFit
    End With
    Unload frmForm
    
End Sub

Display More

Assumes that the new data will be saved after all 6 text boxes for the current hour have been completed.

bugs63 · Aug 28th 2022

The New Code you sent me Thank You again. I really appreciate you for trying to help me with this.

Maybe what i am asking for is not possible. when the Form unloads and then it's reloaded to enter a new set of numbers they are showing up in a different row and it all needs to be on the same row for the date in question. I 'am attaching the Database sheet with the code you provided so you can see what i am talking about.

Book 3.xlsm

**KjBox** · Aug 28th 2022

What you want is certainly possible, issue is trying to establish just what you need

Can you confirm that you need a result as shown in the second image in Post 4?

Can you tell me just how the file is used? In other words is it opened every hour and data for the hour previous hour entered, or is data entered for more than one hour entered each time the file is opened, or something else?

**KjBox** · Aug 29th 2022

I guess, with the workbook in your last attachment, you opened the user form entered data for Time 0000, then saved. Then opened the user form again and entered data for Time 0400 but also re-entered the data for Time 0000 and saved again.

If you had just entered the data for Time 0400 and Saved all would have been good.

Why did you re-entered the data for Time 0000 when data for Time 0000 had already been saved?

bugs63 · Aug 29th 2022

The way the from should work Numbers are entered every hour into the from by different users.

Example one user will enter numbers at 12am, (0000Hours) and then log off. The next user will enter his or her numbers at 1am, (0100hours) then him or her will also log off. We also have some user that like to enter there numbers in the wrong time slot which is fine as long as they are the correct numbers. The Process of entering number and logging off is a 24 hours process that ends at 11pm(2300hours) daily. Here is the trick it all must appear on the worksheet under one Date and in one Row. at the end of lets say a week, all user numbers entered should have the date that they were enter by row, Even if the user picked the wrong time slot. All numbers enter are done on the From. I am the only on with access to the worksheet. .

**KjBox** · Aug 29th 2022

Sorry I am more confused than before.

Quote from bugs63

it all must appear on the worksheet under one Date and in one Row

Yet the second image in post 4, which you said was your desired result, shows the 6 entries for each hour on separate rows.

Quote from bugs63

We also have some user that like to enter there numbers in the wrong time slot which is fine as long as they are the correct numbers.

So somebody enters data for 0200 hours which is correct, then the 0800 hours user also enters his data in the 0200 time slot. That would overwrite the correct 0200 data and leave 0800 empty, and that is "fine"?

You still have not said if the data is saved every hour or if the Save button on the userform is clicked only after the 2300 data has been entered and all times have data.

You have not answered what I asked in Post 17 or said if that was what you did.

bugs63 · Aug 29th 2022

the Save button is click only, all the other buttons on then form are for my use only they can not be access by the users. As for post #17, the repeated numbers i see what you are talking about, that was my fault. the form clears evetime it is saved. so I forgot I had already entered numbers in that time slot. .

Keeping Date and Data in the same Row on a worksheet Using Vba

Participate now!

Share

Similar Threads

find a row in a worksheet

VBA to move rows in one sheet based on data validation

Vba to copy and paste data from two worksheet based on header in another worksheet and compare them.

Match date in cell to the same date in a range and return value from cell below

Uniqe values in listbox an include associated rows (Userform VBA)

Collecting data from multiple rows in one cell