goldbeje
09-05-2012, 11:57 AM
**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:
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
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.
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:
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
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.