A comparison of a set range of columns in to another on the same sheet to highlight rows with differences...

goldbeje

New Member
Joined
Aug 29, 2012
Messages
5
**I do not have rights to attach my workbook.
:confused::confused::confused::confused:


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:
PCRLocationPCR Plate IDSource IDOffsetDNASource ID
PCR1119416J93174_0011DNA1
PCR1119416J93174_0012DNA1
PCR1119416J93174_0013DNA1
PCR1119416J93174_0024DNA2
PCR2119417J93174_0021DNA2
PCR2119417J93174_0022DNA2
PCR2119417J93174_0033DNA3
PCR2119417J93174_0034DNA3
PCR3119418J93174_0031DNA3
PCR3119418J93174_0042DNA4
PCR3119418J93174_0043DNA4
PCR3119418J93174_0044DNA4
PCR4119419J93174_0051DNA5
PCR4119419J93174_0052DNA5
PCR4119419J93174_0043DNA4
PCR4119419J93174_0064DNA6
PCR5119420J93174_0061DNA6
PCR5119420J93174_0062DNA6
PCR5119420J93174_0073DNA7
PCR5119420J93174_0074DNA7
PCR6119421J93174_0071DNA7
PCR6119421J93174_0082DNA8
PCR6119421J93174_0083DNA8
PCR6119421J93174_0084DNA8

<COLGROUP><COL style="WIDTH: 48pt" span=5 width=64><TBODY>
</TBODY>

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:
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:

Code:
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

New Member
Joined
Aug 29, 2012
Messages
5
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.
 

Forum statistics

Threads
1,082,548
Messages
5,366,227
Members
400,880
Latest member
dwb

Some videos you may like

This Week's Hot Topics

Top