How to create a form that logs data?

Hi

Try this.

Sub bbb()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("Sheet2")
  
  outrow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
  
  OutSH.Cells(outrow, 1).Value = OutSH.Cells(outrow - 1, 1).Value + 1
  OutSH.Cells(outrow, 2).Value = Range("C3").Value
  OutSH.Cells(outrow, 3).Value = Range("C4").Value
  OutSH.Cells(outrow, 4).Value = Range("C5").Value
End Sub

rylo

Thank you for that. I may be in over my head here, but where would I apply that code? To the button? Would that constitute the macro?

I created the simplified picture to visually explain what I'm trying to do, but perhaps it would be helpful if I just attached the file that I'm actually working on. I put a button in there, but wasn't really sure what to do with it.

Hi

Don't have excel 2007 on this machine so can you please save the file in 2003 format.

rylo

Here's the same file in 2003 format.

Hi

When in excel, hold down the alt key, and press F11. This will open the VBE. Now go Insert, Module and paste the code into the module. Now go back to the spreadsheet, hold down the ctrl key, right click on the button, select assign macro, select the macro bbb. It will now run when you press the button.

However, the macro was built for your post example, and won't do anything much for your working example. Can you advise where the data on Form is meant to be posted on Database? That way we can set up the code to transfer the data to the right cells.

ryl

Wow, thanks for your help. I've saved a new version of the file, but this time, instead of having same data in the fields on the first sheet, I've replaced it with the names of the headers on the second sheet. You'll notice that the three different "Partner/Principal's" have the same headers for each piece of information, so the headers are just repeated 3 times in the next sheet.

Hi

OK try this.

Sub TransferData()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("Database")
  outrow = OutSH.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
  
  OutSH.Cells(outrow, 2).Resize(1, 2).Value = WorksheetFunction.Transpose(Range("C3:C4").Value)
  OutSH.Cells(outrow, 4).Value = Range("C7").Value
  OutSH.Cells(outrow, 5).Value = Range("C8").Value
  OutSH.Cells(outrow, 6).Value = Range("D8").Value
  OutSH.Cells(outrow, 7).Resize(1, 4).Value = WorksheetFunction.Transpose(Range("C9:C12").Value)
  OutSH.Cells(outrow, "K").Resize(1, 2).Value = Range("C16:D16").Value
  OutSH.Cells(outrow, "M").Resize(1, 2).Value = Range("C17:D17").Value
  OutSH.Cells(outrow, "O").Resize(1, 2).Value = Range("C18:D18").Value
  OutSH.Cells(outrow, "Q").Resize(1, 2).Value = Range("C19:D19").Value
  OutSH.Cells(outrow, "S").Value = Range("C20").Value
  OutSH.Cells(outrow, "T").Resize(1, 15).Value = WorksheetFunction.Transpose(Range("H7:H21").Value)
  
End Sub

rylo