Consulting

Results 1 to 3 of 3

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

  1. #1
    VBAX Regular
    Joined
    Aug 2012
    Posts
    22
    Location

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

    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.

    [vba]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[/vba]
    Any assistance would be much appreciated.

    Thanks for looking!

    J.
    Last edited by Aussiebear; 09-03-2012 at 09:04 PM. Reason: Adjusted the tags to the correct usage

  2. #2
    VBAX Mentor Teeroy's Avatar
    Joined
    Apr 2012
    Location
    Sydney, Australia
    Posts
    414
    Location
    No attachment?
    _________________________________________________________________________
    "In theory there is no difference between theory and practice. In practice there is." - Chuck Reid

    Any day you learn something new is a day not wasted.

  3. #3
    VBAX Regular
    Joined
    Aug 2012
    Posts
    22
    Location

    Exclamation Attachment

    Quote Originally Posted by Teeroy
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •