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
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