**Attached is the workbook. Macro "CheckLocation".. run with no "Sheet2" (macro creates it)
Userform labeled "UserForm1"
I don't even know if this is possible....I have no idea how to code a comparison of a set range of columns with another range of columns and then flag the rows with differences to insert an image in a frame on the userform for that location. Currently the userform displays a "deck layout" for loading dna plates. Each location is labeled on this userform with a frame.
i.e. DNA1 - first location / frame1
DNA2 - second location / frame2
There are a total of (8) DNA locations/frames and (6) PCR locations/frames.
In my active.worksheet (Sheet2), there are rows of data formatted from Sheet(1) by this macro. The userform (Userform1) has (4) textboxes to input the corresponding data into each locations matching row.
Macro formatted rows:
PCRLocation PCRPLateID SourceID Offset DNASourceID
PCR1 119416 J93174_001 1 DNA1
PCR1 119416 J93174_001 2 DNA1
PCR1 119416 J93174_001 3 DNA1
PCR1 119416 J93174_002 4 DNA2
PCR2 119417 J93174_002 1 DNA2
PCR2 119417 J93174_002 2 DNA2
PCR2 119417 J93174_003 3 DNA3
PCR2 119417 J93174_003 4 DNA3
Userform1's textboxes are saving the data to columns in this format right next to the last column shown above. So, repeating the exact information next to it.
First group: "A","E" Second group: "F","J"
If say, column "B" / "PCR Plate ID" has 119416 shown on the left side and the user inputs into the userform 119417 (saved into column "G" on same sheet), the macro would highlight the row and insert an image into the associated frame on the userform to visually notify the user that the PCR Plate and associated DNA plate are incorrect and need to be reloaded.
If say, all cells in the row match, the macro would then insert an image into the frame visually showing that location is good.
Is this even possible?! HELP!!
Code I have for this is below:
Formatting Macro:
Code for the Userform: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 mCol 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 ' Loop through columns For mCol = 4 To 4 With Worksheets("Sheet2").Columns(mCol) ' 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("I").Cells(1, 1) End If End With Next mCol ' Show userform for inputting scans UserForm1.Show ' Hide CopyPaste_Sheet2 from user CopyPaste_Sheet2.Hide End Sub
Dim PCRPlateID As Long Dim DNAPlateID As String Dim DNALocation As Integer Dim PCRPlateLocation As Integer Dim ValueCount As Integer Private Sub CommandButton1_Click() Unload Me End Sub Private Sub InputTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Left(TextBox1.Text, 1) = "J" Then DNAPlateID = TextBox1.Text ValueCount = ValueCount + 1 End If If Left(TextBox3.Text, 1) = "J" Then PCRPlateID = TextBox3.Text ValueCount = ValueCount + 1 End If If Left(TextBox2.Text, 3) = "DNA" Then DNALocation = Right(TextBox2, 1) ValueCount = ValueCount + 1 End If If Left(TextBox4.Text, 3) = "PCR" Then PCRPlateLocation = Right(TextBox4, 1) ValueCount = ValueCount + 1 End If TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" If ValueCount >= 3 Then Else Cancel = True End If End Sub Private Sub CommandButton2_Click() Dim irow As String Dim ws As Worksheet Set ws = Worksheets("Sheet2") 'find first row in Sheet2 based off of last character. PCR1 = 1 DNA3 = 3 irow = (Mid(TextBox2.Value, 4) - 1) * 3 + 2 With ws .Range("H" & irow).Resize(3) = TextBox1.Value .Range("J" & irow).Resize(3) = TextBox2.Value End With TextBox1.Value = "" TextBox2.Value = "" End Sub Private Sub CommandButton3_Click() Dim mrow As String Dim vs As Worksheet Dim rw As Long Set vs = Worksheets("Sheet2") 'find first row in Sheet2 mrow = (Mid(TextBox4.Value, 4) - 1) * 4 + 2 With vs .Range("G" & mrow).Resize(4) = TextBox3.Value .Range("F" & mrow).Resize(4) = TextBox4.Value End With TextBox3.Value = "" TextBox4.Value = "" End Sub Private Sub CommandButton4() End Sub
Thanks for looking at my hurddle!
J.





Reply With Quote