Capturing data from a userform to specifice column rows in a worksheet

[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

'UserForm1

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!

J.

[Teeroy]

No attachment?

[goldbeje]

No attachment?

Please see attachment.. sorry about that.

UserForm2 is the one I am currently working on right now (decided it would be easier if both Userforms were combined. UserForm1 is the one I was having problems with. I would like to have UserForm2 used with a setup for a barcode scanner, like UserForm1 is setup with the checks for scan types. Any assistance would be great.

The idea is that the scans would go into the textboxes and save to the created Sheet2 (macro name CheckLocation). This macro sets up Sheet2 for saving barcodes into the correct columns in Sheet2. The macro when done would need to verify both columns for each barcode match and highlight the respective Frame location True or False.

Let me know if this is confusing.

Thanks,
J.