Copying date into first empty cell in a column

Question

I am creating a form to submit when parts in a shop are delivered or taken out.

I want to copy a cell from one sheet to another.

Form:

One of the sheets the data will be copied to:

I have been predominately using if then statements to copy the sheet.

Private Sub SUBMITFORM_Click()
Call TransferDeliveryInfo()
End Sub


Sub TransferDeliveryInfo()

'make sure to unlock sheet
Sheets("Deliveries").Select
ActiveSheet.Unprotect ("mustache")

Sheets("Parts In-Out Form").Select

Range("d9").Select

If ActiveCell.Value = ("In") Then

    Sheets("Parts In-Out Form").Select

    Range("b12:b42", "d12:d42").Select

ElseIf ActiveCell.Value > 0 Then

    'Copying Part Number and Quanity
    Selection.Copy

    Sheets("Deliveries").Select
    Range("c1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("b1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

    'Copying Date
    Sheets("Parts In-Out Form").Select
    Range("b9").Select

    Selection.Copy

    Sheets("Deliveries").Select
    Range("a1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("a1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

    'Copy Employee Number
    Sheets("Parts In-Out Form").Select
    Range("f9").Select

    Selection.Copy

    Sheets("Deliveries").Select
    Range("e1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("e1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

    'Copy BOL Number
    Sheets("Parts In-Out Form").Select
    Range("h9").Select

    Selection.Copy

    Sheets("Deliveries").Select
    Range("b1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("b1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

    Sheets("Deliveries").Select
    ActiveSheet.Protect ("mustache")

    Sheets("Parts In-Out Form").Select

    Application.EnableEvents = True
    Application.ScreenUpdating = True

Else

    Call TransferPartsOutInfo

End Sub


Sub TransferPartsOutInfo()

Application.EnableAnimationsEvents = False
Application.ScreenUpdating = False

Sheets("Parts In-Out Form").Select

Range("b12:b42", "d12:d42").Select

If ActiveCell.Value > 0 Then

    'Copying Part Number and Quanity
    Selection.Copy

    Sheets("Items Out").Select
    Range("c1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("b1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

    'Copying Date
    Sheets("Parts In-Out Form").Select
    Range("b9").Select

    Selection.Copy

    Sheets("Items Out").Select
    Range("a1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("a1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

    'Copy Employee Number
    Sheets("Parts In-Out Form").Select
    Range("f9").Select

    Selection.Copy

    Sheets("Items Out").Select
    Range("e1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("e1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

    'Copy Crew or Work Order Number
    Sheets("Parts In-Out Form").Select
    Range("h9").Select

    Selection.Copy

    Sheets("Items Out").Select
    Range("b1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("b1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

Else

    Sheets("Items Out").Select
    ActiveSheet.Protect ("mustache")

End If

Sheets("Parts In-Out Form").Select

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

What I am trying to achieve:

If a cell on sheetA says "In" copy to sheetB.
If a cell on sheetA says "Out" copy to sheetC.

Furthermore I am trying to:

copy data in a range if there is a value in two columns
not overwrite data in sheetB or sheetC.

The program runs but it will not paste the values.

When I get home, i'll take a look over the code. But as a thought, i would try to avoid using `.select`. This can cause problems, and i would suggest just not using it at all. For some helpful hints about avoiding `.select` visit this link here...https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba — IrwinAllen13, Feb 08 '19 at 21:47
Actually, to be honest, I consider reading the above link i posted about avoiding `.select`. I believe you could fix the above code to make it work, but in the long run it would be better suited to focus on NOT using `.select` and you will see the amount of code drop way down. — IrwinAllen13, Feb 08 '19 at 21:54

Copying date into first empty cell in a column

0 Answers0