excel - l form to save data in Access -

good day !!

i manage contact center , require staff capture data calculate productivity

this could've been done through access forms, team not allowed have access due policies

i wanted know if create few predefined fields in excel data entry (dropdowns , free text), agents enter information each time, click "submit" button.

once "submit" button clicked, data passed access table, , excel fields reset blank.

note: each agent has excel file name stored on our shared drive. access stored on shared drive. paths predefined , fixed.

can please

i'm sure has been posted somewhere before, cant seem find exact requirements.

thanks

that should work. copy, paste , adjust workbook name.

option explicit  sub updatelogworksheet()      dim historywks worksheet     dim inputwks worksheet      dim wb1 worksheet      dim nextrow long     dim ocol long      dim myrng range     dim mycopy string     dim mycell range      'cells copy input sheet - contain formulas     mycopy = "d5,d7,d9,d11,d13"      set inputwks = worksheets("input")     set historywks = worksheets("partsdata")      set wb1 = workbooks("1.xls").worksheets("partsdata") 'change workbook      inputwks         set myrng = .range(mycopy)          if application.counta(myrng) <> myrng.cells.count             msgbox "please fill in cells!"             exit sub         end if     end      wb1         nextrow = .cells(.rows.count, "a").end(xlup).offset(1, 0).row         .cells(nextrow, "a")             .value =             .numberformat = "mm/dd/yyyy hh:mm:ss"         end         .cells(nextrow, "b").value = application.username         ocol = 3         each mycell in myrng.cells             .cells(nextrow, ocol).value = mycell.value             ocol = ocol + 1         next mycell     end      'clear input cells contain constants     inputwks       on error resume next          .range(mycopy).cells.specialcells(xlcelltypeconstants)               .clearcontents               application.goto .cells(1) ', scroll:=true          end       on error goto 0     end end sub 

edit:

option explicit  sub updatelogworksheet()  application.screenupdating = false      dim historywks worksheet     dim inputwks worksheet     dim wb1 worksheet      dim nextrow long     dim ocol long      dim wb_path string     dim mycopy string     dim wb_name string      dim myrng range     dim mycell range      'cells copy input sheet - contain formulas     mycopy = "d5,d7,d9,d11,d13"     wb_name = "1.xls" '2nd workbook name     wb_path = "c:\reports\" & wb_name '2nd workbook path on hdd      set inputwks = thisworkbook.worksheets("input") 'form sheet     set historywks = thisworkbook.worksheets("partsdata") 'data in form sheet      set myrng = inputwks.range(mycopy)      if application.counta(myrng) <> myrng.cells.count         msgbox "please fill in cells!"         exit sub     end if      'if 2nd workbook file not exists, message pop     if dir(wb_path) = ""         msgbox ("file not exists")         exit sub:      'if exists open , become invisible     else         workbooks.open filename:=wb_path         application.windows(wb_name).visible = false         set wb1 = workbooks(wb_name).worksheets("partsdata") 'data in 2nd workbook          'copy data 2nd workbook         wb1             nextrow = .cells(.rows.count, "a").end(xlup).offset(1, 0).row             .cells(nextrow, "a")                 .value =                 .numberformat = "mm/dd/yyyy hh:mm:ss"             end             .cells(nextrow, "b").value = application.username             ocol = 3             each mycell in myrng.cells                 .cells(nextrow, ocol).value = mycell.value                 ocol = ocol + 1             next mycell         end          application.windows(wb_name).visible = true         workbooks(wb_name).close true      end if      'copy data form sheet     historywks         nextrow = .cells(.rows.count, "a").end(xlup).offset(1, 0).row         .cells(nextrow, "a")             .value =             .numberformat = "mm/dd/yyyy hh:mm:ss"         end         .cells(nextrow, "b").value = application.username         ocol = 3         each mycell in myrng.cells             .cells(nextrow, ocol).value = mycell.value             ocol = ocol + 1         next mycell     end       'clear input cells contain constants     inputwks       on error resume next          .range(mycopy).cells.specialcells(xlcelltypeconstants)               .clearcontents               application.goto .cells(1) ', scroll:=true          end       on error goto 0     end  application.screenupdating = true  end sub