Macro submit button

Last Edited By Krjb Donovan
Last Updated: Mar 05, 2014 09:45 PM GMT

Question

QUESTION: Im trying to create a form inand am using macro for the first time. I want a form in sheet1 that when submitted it records the answers in a database in sheet2. i have managed this but when i fill in the form for the second time it overwrites the row in the databse and im not sure how to make it auotmatically use the next row down. im sure its very simple but its driving me mad! This is what i have so far Sub Button9_Click() Worksheets("Database").Range("A6").Value = Worksheets("Form").Range("E3") Worksheets("Database").Range("A6").Value = Worksheets("Form").Range("E3") Worksheets("Database").Range("B6").Value = Worksheets("Form").Range("E4") Worksheets("Database").Range("C6").Value = Worksheets("Form").Range("e7") Worksheets("Database").Range("d6").Value = Worksheets("Form").Range("e8") Worksheets("Database").Range("e6").Value = Worksheets("Form").Range("e9") Worksheets("Database").Range("f6").Value = Worksheets("Form").Range("e10") Worksheets("Form").Range("e3").ClearContents Worksheets("Form").Range("e4").ClearContents Worksheets("Form").Range("e7").ClearContents Worksheets("Form").Range("e8").ClearContents Worksheets("Form").Range("e9").ClearContents Worksheets("Form").Range("e10").ClearContents End Sub

Please help, am i doing this correctly Naomi

ANSWER: Naomi,

If you go to the bottom of the worksheet with your data in column A and hit the End key, then the up arrow, it should take you to the last row of data in your database. We can use this same technique in code.

Sub Button9_Click() Dim rw as Long With Worksheets("Database")

 rw = .Cells(.Rows.Count, "A").End(xlUp).Row
 If rw < 6 Then
   rw = 0
 Else
   rw = rw - 5
 End If
 .Range("A6").Offset(rw, 0).Value = Worksheets("Form").Range("E3")
 .Range("B6").Offset(rw, 0).Value = Worksheets("Form").Range("E4")
 .Range("C6").Offset(rw, 0).Value = Worksheets("Form").Range("e7")
 .Range("D6").Offset(rw, 0).Value = Worksheets("Form").Range("e8")
 .Range("E6").Offset(rw, 0).Value = Worksheets("Form").Range("e9")
 .Range("F6").Offset(rw, 0).Value = Worksheets("Form").Range("e10")

End With Worksheets("Form").Range("e3").ClearContents Worksheets("Form").Range("e4").ClearContents Worksheets("Form").Range("e7").ClearContents Worksheets("Form").Range("e8").ClearContents Worksheets("Form").Range("e9").ClearContents Worksheets("Form").Range("e10").ClearContents End Sub

the above worked for me.


---------- FOLLOW-UP ----------

QUESTION: thank you so so much for your help and quick response it was amazing i have one more small question. I have now created a Stock summary to analize stock, ordered items etc.... i have a worksheet called stocksummary when a stock level is low a cell returns as "ORDER!" so we can visibily see what stock is running low. i have created a new macro that when a stock level is low u click a button and it transfers everything we need to "ORDER!" in to a order form. at the moment it transfers the entire row but i only want it to transfer rows from column B,C & G into order form A,C & F. can this be done i hope you understand my request this is what i already have

Sub SearchForString()

   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer
   
   On Error GoTo Err_Execute
   'Start search in row 8
   LSearchRow = 8
   'Start copying data to row 2 in Sheet2 (row counter variable)
   LCopyToRow = 28
   While Len(Range("h" & CStr(LSearchRow)).Value) > 0
       'If value in column h = "ORDER!", copy entire row to Sheet2
       If Range("H" & CStr(LSearchRow)).Value = "ORDER!" Then
           'Select row in Sheet1 to copy
           Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
           Selection.Copy
           'Paste row into Sheet2 in next row
           Sheets("Order Form").Select
           Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
           ActiveSheet.Paste
           'Move counter to next row
           LCopyToRow = LCopyToRow + 1
           'Go back to Sheet1 to continue searching
           Sheets("Stock Summary").Select

Selection.PasteSpecial Paste:=xlValues

       End If
       LSearchRow = LSearchRow + 1
   Wend
   'Position on cell A3
   Application.CutCopyMode = False
   Range("A3").Select
   MsgBox "All matching data has been copied."
   Exit Sub

Err_Execute:

   MsgBox "An error occurred."

End Sub


Answer

Naomi,

this worked for me:

You won't see the screen flashing back and forth. I hope that is alright.

Sub SearchForString()

  Dim LSearchRow As Integer
  Dim LCopyToRow As Integer
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim r1 As Range, cell As Range
  
  On Error GoTo Err_Execute
  'Start search in row 8
  LSearchRow = 8
  'Start copying data to row 2 in Sheet2 (row counter variable)
  LCopyToRow = 28
  Set sh2 = Worksheets("Order Form")
  Set sh1 = Worksheets("Stock Summary")
  Set r1 = sh1.Range(sh1.Cells(8, "H"), sh1.Cells(Rows.Count, "H").End(xlUp))
  For Each cell In r1
      'If value in column h = "ORDER!", copy entire row to Sheet2
      If cell.Value = "ORDER!" Then
          ' only want it to transfer rows from column B,C & G into order form A,C & F
          'Select row in Sheet1 to copy
          sh2.Cells(LCopyToRow, "A").Value = sh1.Cells(cell.Row, "B").Value
          sh2.Cells(LCopyToRow, "C").Value = sh1.Cells(cell.Row, "C").Value
          sh2.Cells(LCopyToRow, "F").Value = sh1.Cells(cell.Row, "G").Value
          LCopyToRow = LCopyToRow + 1
      End If


  Next
  'Position on cell A3
  Application.CutCopyMode = False
  Range("A3").Select
  MsgBox "All matching data has been copied."
  Exit Sub

Err_Execute:

  MsgBox "An error occurred."

End Sub

Advertisement

©2021 eLuminary LLC. All rights reserved.