Capturing data from a userform and saving it to specific column in Sheet2

[goldbeje]

I have a macro that is starting to get pretty intensive and beyond my knowledge base. Currently is takes the needed data from sheet(1) and copies it to a newly created "Sheet2" in a specific format. Once the macro is done formatting "Sheet2", it shows both userforms for the next part of this macro.

One userform (UserForm1) is for inputting barcode data into rows on "Sheet2" (this is where I am running into problems). I cannot get the userform to capture the captions to the needed cells in "Sheet2".

The other userform (UserForm2) is for a visual representation of the error check. This will check for differences in Sheet2's column data. If a row's data in Sheet2 doesn't duplicate as expected it will flag RED and an image to show in the associated frame in UseForm2.

---

UserForm1:

Plate ID (PlateIDLabel goes to "PCR Plate ID" header column in Sheet2)
Plate Location (PlateLocationLabel goes to "PCRLocation" header column in Sheet2)

Currently the userform is coded to recognize prefixes for correct input into label textboxes.

Attached it the workbook with macro/userforms.

Option Explicit
Private Sub CommandButton1_Click()
Sheets.Add.Name = "Sheet2"
ActiveSheet.Move _
       After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
       'Moves active sheet to end of active workbook.
       
      ActiveWorkbook.Sheets(1).Activate
    Dim r As Range
    Dim srcID As String
    Dim lr, sR, i, c, INDX As Long
    Dim iCol As Long
    Dim PCRCopy As Range
    Dim Rng As Range
    Dim regEx
    Dim Whole As Range
    Dim DNACopy As Range
    
             
Set regEx = CreateObject("vbscript.regexp")
    'Add replicates of (4) to "Sheet2" Column "B"
    Set r = ActiveSheet.Range("B1:B999").Find(What:="PCR Plate ID", LookAt:=xlPart)
    INDX = 1
    i = 2
    lr = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    Range("B" & r.Row & ",C" & r.Row & ",G" & r.Row).Copy Destination:=Sheets(2).Range("B1")
    For c = (r.Row + 1) To lr Step 3
        srcID = Range("B" & c).Text
                
        With Sheets(2)
            .Range("A" & i & ":A" & i + 3).Value = INDX
            .Range("B" & i & ":B" & i + 3).Value = srcID
        End With
         
        Range("C" & c & ",G" & c).Copy Destination:=Sheets(2).Range("C" & i)
        Range("H" & c & ",L" & c).Copy Destination:=Sheets(2).Range("C" & i + 1)
        Range("C" & c + 1 & ",G" & c + 1).Copy Destination:=Sheets(2).Range("C" & i + 2)
        Range("H" & c + 1 & ",L" & c + 1).Copy Destination:=Sheets(2).Range("C" & i + 3)
         
        i = i + 4
        INDX = INDX + 1
    Next c
    
    'Formatting Sheet2 (ActiveSheet)
    CopyPaste_Sheet2.Hide
    ActiveWorkbook.Sheets(2).Activate
    Sheets("Sheet2").Range("A1") = "Location"
    Sheets("Sheet2").Range("E1") = "Location"
           
    'Insert "PCR" to the front of Column A cells
    For Each PCRCopy In Range(Sheets("Sheet2").Range("A1"), Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp))
    If PCRCopy.Value <> "" Then PCRCopy.Value = "PCR" & PCRCopy.Value
        Next
   
   'Parse cells at D and D*
    With regEx
    .IgnoreCase = True
    .MultiLine = False
    .Pattern = "D.{0,2}$"
    .Global = True
End With
For Each Rng In Range(Sheets("Sheet2").Range("c2"), Sheets("Sheet2").Range("c" & Rows.Count).End(xlUp))
    Rng.Value = regEx.Replace(Rng, "")
Next
 ' Loop through columns
     For iCol = 3 To 3
        With Worksheets("Sheet2").Columns(iCol)
        ' Check that column is not empty.
            If .Cells(1, 1).Value = "" Then
            'Nothing in this column.
            'Do nothing.
            Else
                 ' Copy the column to the destination
                 Range(.Cells(1, 1), .End(xlDown)).Copy _
                    Destination:=Worksheets("Sheet2").Columns("E").Cells(1, 1)
            End If
         End With
     Next iCol
    
    'Parse the first 8 characters off column E cells
    For Each Whole In Range(Sheets("Sheet2").Range("E2"), Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp))
    Whole = Right(Whole, Len(Whole) - 8)
        Next
    
    'Align column E to the Right
    Sheets("Sheet2").Range("E1:E999").HorizontalAlignment = xlRight
    'Insert "DNA" to the front of Column E cells
    For Each DNACopy In Range(Sheets("Sheet2").Range("E1"), Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp))
    If DNACopy.Value <> "" Then DNACopy.Value = "DNA" & DNACopy.Value
        Next
        
    ' Copy Header Rows for Scanning lines
   Range("A1:E1").Select
   Selection.Copy
   Sheets("Sheet2").Select
   Range("F1:J1").Select
   ActiveSheet.Paste
        ActiveSheet.Range("F2").Select
    'Show both userforms for inputting scans
    UserForm1.Show vbModeless
    UserForm1.Left = UserForm1.Left - UserForm1.Width / 2
    UserForm2.Show vbModeless
    UserForm2.Left = UserForm2.Left + UserForm1.Width / 2
    CopyPaste_Sheet2.Hide
    
End Sub

'USERFORM

Dim PlateID As String
Dim PlateLocationID As Integer
Dim irow As Long
Dim ws As Worksheet
 
Private Sub InputTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Left(InputTextBox.Text, 1) = "J" Then
PlateID = InputTextBox.Text
PlateIDLabel.Caption = PlateID
ValueCount = ValueCount + 1
End If
If Left(InputTextBox.Text, 3) = "DNA" Then
PlateLocationID = Right(InputTextBox, 1)
PlateLocationLabel.Caption = PlateLocationID
ValueCount = ValueCount + 1
End If
InputTextBox.Text = ""
Dim OkToProceede As Boolean
OkToProceede = True
If PlateID = "" Then OkToProceede = False
If PlateLocationID = 0 Then OkToProceede = False
If OkToProceede = True Then
Else
Cancel = True
End If
End Sub
 
Private Sub Reset()
PCRPlateID = 0
JobNumber = ""
LocationID = 0
PCRPlateLabel.Caption = ""
JobNumberLabel.Caption = ""
LocationLabel.Caption = ""
InputTextBox.SetFocus
End Sub

Any assistance would be much appreciated.

Thanks for looking!

***I can't find an attachment option or I would attach the workbook. Any assistance is appreciated. I am new to this forum.

J.