2
\$\begingroup\$

I have two worksheets in my workbook. The first worksheet ("home"), the user will enter information in cells B7-B14, not all of the fields are required in order for the macro to proceed. I need each of the aforementioned fields to be copied over (in addition to B18-B28 & B31-B34) onto the second worksheet ("tracking"), based on the header in each column (this will allow the macro to continue to work should the user add columns). Furthermore, in the home worksheet there is a field that dictates whether this data should be repeated. Meaning if the user enters a value of "2" in cell B15 then all of the fields should be copied on to one row and then the again on next row, where the only difference between the two rows is that the value of B18 when copied over to the "tracking" worksheet should go up by an increment of 1, this cell needs to have 3 leading zeros. The macro should identify the last row and copy the information over to the next blank row.

right now my code just copies and pastes based on the exact range rather than searching for the column header and then pasting the data.

i thought it might be helpful to include the headers on my tracking tab it is attached. enter image description here

i also haven't figured out the last piece, please help!

Option Explicit

Sub EnterInfo()

Dim LastRow As Long
Dim InvoiceNo As String

LastRow = Track.Range("A" & Rows.Count).End(xlUp).Row

'Required Fields
If IsEmpty(Home.Range("B7")) Then
    MsgBox ("Please enter the Delivery Date before continuing.")
    Exit Sub
ElseIf IsEmpty(Home.Range("B8")) Then
    MsgBox ("Please enter the Harvest Date before continuing.")
    Exit Sub
ElseIf IsEmpty(Home.Range("B12")) Then
    MsgBox ("Please enter the Package Date before continuing.")
    Exit Sub
ElseIf IsEmpty(Home.Range("B13")) Then
    MsgBox ("Please enter the Purchase Order Date before continuing.")
    Exit Sub
ElseIf IsEmpty(Home.Range("B14")) Then
    MsgBox ("Please enter the Purchase Order Number before continuing.")
    Exit Sub
ElseIf IsEmpty(Home.Range("B15")) Then
    MsgBox ("Please enter the Number of Boxes before continuing.")
    Exit Sub
Else
    Home.Range("B7").Copy
    Track.Cells(LastRow + 1, "C").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Home.Range("B8").Copy
    Track.Cells(LastRow + 1, "G").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Home.Range("B12").Copy
    Track.Cells(LastRow + 1, "K").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Home.Range("B13").Copy
    Track.Cells(LastRow + 1, "R").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Home.Range("B14").Copy
    Track.Cells(LastRow + 1, "S").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Home.Range("B19").Copy
    Track.Cells(LastRow + 1, "T").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Home.Range("B20").Copy
    Track.Cells(LastRow + 1, "P").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Home.Range("B21").Copy
    Track.Cells(LastRow + 1, "L").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Home.Range("B25").Copy
    Track.Cells(LastRow + 1, "E").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Home.Range("B26").Copy
    Track.Cells(LastRow + 1, "B").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Home.Range("B31").Copy
    Track.Cells(LastRow + 1, "D").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Home.Range("B32").Copy
    Track.Cells(LastRow + 1, "F").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Home.Range("B33").Copy
    Track.Cells(LastRow + 1, "V").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Home.Range("B34").Copy
    Track.Cells(LastRow + 1, "W").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If



If Home.Range("B9") <> "" Then
    Home.Range("B9").Copy
    Track.Cells(LastRow + 1, "H").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Home.Range("B22").Copy
    Track.Cells(LastRow + 1, "M").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If

If Home.Range("B10") <> "" Then
    Home.Range("B10").Copy
    Track.Cells(LastRow + 1, "I").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Home.Range("B23").Copy
    Track.Cells(LastRow + 1, "N").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If

If Home.Range("B11") <> "" Then
    Home.Range("B11").Copy
    Track.Cells(LastRow + 1, "J").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Home.Range("B24").Copy
    Track.Cells(LastRow + 1, "O").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If


End Sub
\$\endgroup\$
1
\$\begingroup\$

A function able to set the column number according to the column header would be the next one. Please replace ActiveSheet from the Track worksheet definition

Private Function HdN(strHead As String) As Long
  Dim hdArr As Variant, Track As Worksheet, i As Long, lastCol As Long
  Set Track = ActiveSheet 'Attention! define here your real sheet. I used it for testing
  lastCol = Track.Cells(1, Track.Columns.count).End(xlToLeft).Column
  hdArr = Track.Range("A1:" & Cells(1, lastCol).Address).Value
  HdN = Application.WorksheetFunction.Match(strHead, hdArr, 0)
End Function

It can be used in the next way:

Instead of Track.Cells(LastRow + 1, "C") you can use Track.Cells(LastRow + 1, HdN("Delivery Date")). If the actual column will be cut and inserted in a different place, it can be identified.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.