Comparison of a set range of columns on the same sheet to insert correct image on userform

**goldbeje** · 09-05-2012, 02:52 PM

**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 PCR Plate ID Source ID Offset DNASource ID
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
PCR3 119418 J93174_003 1 DNA3
PCR3 119418 J93174_004 2 DNA4
PCR3 119418 J93174_004 3 DNA4
PCR3 119418 J93174_004 4 DNA4
PCR4 119419 J93174_005 1 DNA5
PCR4 119419 J93174_005 2 DNA5
PCR4 119419 J93174_004 3 DNA4
PCR4 119419 J93174_006 4 DNA6
PCR5 119420 J93174_006 1 DNA6
PCR5 119420 J93174_006 2 DNA6
PCR5 119420 J93174_007 3 DNA7
PCR5 119420 J93174_007 4 DNA7
PCR6 119421 J93174_007 1 DNA7
PCR6 119421 J93174_008 2 DNA8
PCR6 119421 J93174_008 3 DNA8
PCR6 119421 J93174_008 4 DNA8

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:

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

Code for the Userform:

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 based off of last character. PCR1 = 1 DNA3 = 3
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
Sub CommandButton4()
End Sub

Thanks for looking at my hurddle!

J.

**goldbeje** · 09-05-2012, 04:11 PM

I am not even sure if this is possible.. if anyone knows that would be helpful. I don't want to spend too much time on this if it isn't possible.
Thanks.