Copy multiple blocks of data in different columns from one worksheet and paste append in single row of another worksheet

[KarenBaDaren]

Greetings. I'm not a VBA expert, am used to Access but our company doesn't allow it so I'm stuck with Excel. I'm creating a checksheet for inspectors to enter data. I want the data entry fields to look exactly like the sheet that prints out from the inspection point. All of the data is entered by a technician by hand.

Let's say I have data in a worksheet named "Input", header data is stored in D5:D10. D10 indicates if there are two inspection sheets or one. If there is one, the data is entered in cells:

D11:D19 then
J11:J24 then
Q11:Q15.
Any additional cells are not required to have data entered. If D10 indicates there are TWO parts checked, in addition to the three sections above, I now have the cells:
D28:D36 then
J28:J41 then
Q28:Q32.

I want to click a simple button that says "Add this data to database." That will then copy the header and the first section of data from "Input", plus the second section of data from "Input" but ONLY if there are two parts inspected from the worksheet. Then it will past that entire group of data in a nice single row, which is the next empty row on sheet "PartsData", beginning with Column C, and clear the data on "Input" and assign it the next ID number. Column C is set up as a unique ID, and there are no problems with it either finding the next ID number, or entering that on the PartsData worksheet.

I had everything working perfectly as long as the data to be copied was in a single column, which I had previously named "Order Entry" in the name manager. As soon as I split it into essentially six sets of data (even updating the Order Entry linked cells in Name Manager), nothing works properly and only certain pieces of data are copied while others aren't copied, aren't cleared, etc.

Essentially,
D11:D19 from Input would go to the next row of PartsData, at (C13:Q13, where the number 13, as an example, would be replaced with the next empty row)
J11:J24 from Input would go to R:AE of that same row above on PartsData.
Q11:Q15 from Input would go to AF:AJ of that same row on PartsData

If Applicable,
D28:D36 from Input would go to AK:AS of that same row on PartsData
J28:J41 from Input would go to AT:BG of that same row on PartsData
Q28:Q32 from Input would go to BH:BL of that same row on PartsData

Then clear the original data on the Input worksheet.

I've just about lost my last brain cell trying to get it to work, and any help is appreciated.

Thanks so much,
Karen

 

[JLGWhiz]

If you already have code to do some of the copying and all you need is a method for getting the split ranges copied over, then maybe something like this would work.

Sub t()
With Sheets("Input")
    If .Range("D10") = 1 Or .Range("D10") = 2 Then
        .Range("D11:D19").Copy
        Sheets("PartsData").Cells(Rows.Count, 3).End(xlUp)(2).PasteSpecial Transpose:=True
        .Range("J11:J24").Copy
        Sheets("PartsData").Cells(Rows.Count, 3).End(xlUp).Offset(0, 15).PasteSpecial Transpose:=True
        .Range("Q11:Q15").Copy
        Sheets("PartsData").Cells(Rows.Count, 3).End(xlUp).Offset(0, 29).PasteSpecial Transpose:=True
    End If
    If .Range("D10") = 2 Then
        .Range("D28:D36").Copy
        Sheets("PartsData").Cells(Rows.Count, 3).End(xlUp).Offset(0, 34).PasteSpecial Transpose:=True
        .Range("J28:J41").Copy
        Sheets("PartsData").Cells(Rows.Count, 3).End(xlUp).Offset(0, 43).PasteSpecial Transpose:=True
        .Range("Q28:Q32").Copy
        Sheets("PartsData").Cells(Rows.Count, 3).End(xlUp).Offset(0, 57).PasteSpecial Transpose:=True
    End If
End With
End Sub

This will copy and transpose your data into the same next available row at the ranges you specified starting in column C. You can work the code above into your existing code at the appropriate place.

 

[KarenBaDaren]

JLGWhiz, I LOVE you! That worked, and you have saved my sanity! I do have one new request that popped up though.

This is the new sub I have:

Sub UpdateLogWorksheet()
    Dim historyWks As Worksheet
    Dim inputWks As Worksheet
    Dim nextRow As Long
    Dim oCol As Long
    Dim myCopy As Range
    Dim myTest As Range
    
    Dim lRsp As Long
    Set inputWks = Worksheets("Input")
    Set historyWks = Worksheets("PartsData")
    oCol = 3 'order info is pasted on data sheet, starting in this column
    
    'check for duplicate order ID in database
    If inputWks.Range("CheckID") = True Then
      lRsp = MsgBox("Order ID already in database. Update record?", vbQuestion + vbYesNo, "Duplicate ID")
      If lRsp = vbYes Then
        UpdateLogRecord
      Else
        MsgBox "Please change Order ID to next unique number."
      End If
    
    Else
    
    'cells to copy from Input sheet - some contain formulas
    Set myCopy = inputWks.Range("OrderEntry")
    With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With
With inputWks
          'mandatory fields are tested in hidden column
        Set myTest = myCopy.Offset(0, 2)
        If Application.Count(myTest) > 0 Then
            MsgBox "Please fill in all the cells!"
            Exit Sub
        End If
    End With
          'copy the order data and paste onto data sheet
    With Sheets("Input")
    If .Range("D10") = 1 Or .Range("D10") = 2 Then
        .Range("D5:D19").Copy
        Sheets("PartsData").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
        .Range("J11:J24").Copy
        Sheets("PartsData").Cells(Rows.Count, 3).End(xlUp).Offset(0, 15).PasteSpecial Transpose:=True
        .Range("Q11:Q15").Copy
        Sheets("PartsData").Cells(Rows.Count, 3).End(xlUp).Offset(0, 29).PasteSpecial Transpose:=True
    End If
    If .Range("D10") = 2 Then
        .Range("D28:D36").Copy
        Sheets("PartsData").Cells(Rows.Count, 3).End(xlUp).Offset(0, 34).PasteSpecial Transpose:=True
        .Range("J28:J41").Copy
        Sheets("PartsData").Cells(Rows.Count, 3).End(xlUp).Offset(0, 43).PasteSpecial Transpose:=True
        .Range("Q28:Q32").Copy
        Sheets("PartsData").Cells(Rows.Count, 3).End(xlUp).Offset(0, 57).PasteSpecial Transpose:=True
    End If
    With historyWks
          'enter date and time stamp in record
        With .Cells(nextRow, "A")
            .Value = Now
            .NumberFormat = "mm/dd/yyyy hh:mm:ss"
        End With
        'enter user name in column B
        .Cells(nextRow, "B").Value = Application.UserName
    End With
    End With
    
    'clear input cells that contain constants
    With inputWks
      On Error Resume Next
         With myCopy.Cells.SpecialCells(xlCellTypeConstants)
              .ClearContents
              Application.Goto .Cells(1) ', Scroll:=True
         End With
      On Error GoTo 0
    End With
    
  End If
StartNewRecord
End Sub

It works GREAT, except there is a timestamp within that code, and the timestamp ends up being the time at which the LAST data point was entered. So for instance, I haven't entered data yet for today, but when I do, it already has the timestamp of yesterday which is when I entered the last data point for the day. I want the timestamp to be for whatever time I hit that button that activates the macro. If days go by (such as over the weekend) since the last measurement data entry, I may have data that prompt me to make a reaction based on parts I made last week, when in fact the issue didn't start until this morning's measurements. Any suggestions there?

Thanks again!

Karen

 

[JLGWhiz]

Depends on what you are using the time stamp for. If, when you look at the worksheet, you want to know the date/time of the last record update then it is fine as it is. Make no difference whether the stamp is when you activate the macro or when you complete the entries. The difference in the time will be how long it takes the macro to run, the date assigned by the macro will be the same. If you change it, it could screw up the metrics that somebody is tracking. All you have to do is move that section of the code to the top of the macro to do what you are suggesting, but it seems like an exercise in futility to me.