Announcement

Collapse
No announcement yet.

$30 AUD Lookup & copy data from "Front" to "Open"

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • $30 AUD Lookup & copy data from "Front" to "Open"



    Look for data on " Front" sheet then lookup cells on "Open" Sheet and paste

    Front Sheet concerned cells are D6, F6, J6,
    Cells to be aware of L6 & Q6


    PayPal Transaction ID 9WL25823AP475942E $30. Full Payment

    Please Note

    I have read the rules but I figured $3 as a 10% I would be better off making the whole amount.
    Then even if nobody takes on the project I have made a donation towards the Forum.


    Peter
    Attached Files
    Last edited by Potholes; 3 weeks ago.

  • #2
    I can look at this for you
    We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

    Comment


    • #3
      PayPal Transaction ID 9WL25823AP475942E $30. Full Payment
      Do you mean you paid 10% ($3) to [email protected] ?
      We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

      Comment


      • #4
        Hi Peter Here

        I have paid the full $30 Dollars because $3 dollars seemed a silly amount to pay,
        I am not rich But I have to pay for each of my Bank transaction each month when I exceed a certain number.

        As I said If nobody took it on Then it was a donation to the forum.

        Peter

        Please ask away for any direction on my needs

        Comment


        • #5
          Hi Peter,

          Just an FYI - the 10% is a posting fee that's paid to OzGrid and is non-refundable. The remaining 90% is paid directly to the developer who carries out the work (which you arrange between yourselves) rahter than OzGrid if that makes sense?

          KjBox - once Potholes agreeds the solution is complete, please both PM me and I'll get the transfer arranged to you.

          Let me know if there's anything I can assist with guys

          Comment


          • #6
            Please explain what you mean by "select( D2, F2, J6,) vlookup "Sheet 1" (Cells A1:Z107 ) "

            D2 and F2 on the Front sheet do not contain data.
            We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

            Comment


            • #7
              Assuming you meant D6 and F6 I think I understand your requirements, try the attached version of your file.

              Note I made the data entry cells for both Open and Training into named ranges ("OpenData" and "TrgData").

              Code in the Front sheet Object Module is now
              Code:
              Option Explicit
              
              Private Sub Worksheet_Change(ByVal Target As Range) 'updated by Sintek 12 August 2019 to do XXX
                  Dim x, wRow, wsArr, i As Long, ii As Long, iii As Long
                  wsArr = Array("Open", "Training")
                  
                  If Target.Count > 1 Then Exit Sub
              'Coded by Alf
                  If Not Intersect(Target, [OpenData]) Is Nothing Then
                      Application.EnableEvents = False
                      Target = StrConv(Target, vbUpperCase)
                      Application.EnableEvents = True
                  End If
                  
                  If Not Intersect(Target, Range("D6", "D6")) Is Nothing Then
                      Target.Offset(, 10).ClearContents
                      Target.Offset(, 10).Interior.Color = vbYellow
                      For i = LBound(wsArr) To UBound(wsArr)
                          If i = 0 Then ii = 6 Else ii = 11
                          With Sheets(wsArr(i))
                              wRow = Application.Match(Target, .Columns(1), 0)
                              If Not IsError(wRow) Then
                                  If Application.CountIf(.Cells(wRow, 3).Resize(, ii), "V") <> 0 Then
                                      Target.Offset(, 10) = "V"
                                  ElseIf Application.CountIf(.Cells(wRow, 3).Resize(, ii), "W") <> 0 Then
                                      Target.Offset(, 10) = "W"
                                  End If
                                  If Target.Offset(, 10) = "V" Or Target.Offset(, 10) = "W" Then
                                      Do Until x = 7
                                          Target.Offset(, 10).Interior.Color = vbRed
                                          Delay (0.04)
                                          Target.Offset(, 10).Interior.Color = vbWhite
                                          Delay (0.04)
                                          x = x + 1
                                      Loop
                                      Target.Offset(, 10).Interior.Color = vbRed
                                  End If
                              End If
                          End With
                      Next i
              '***********************************************************************
              '// Code by KjBox (Ozgrid)
                  ElseIf Target.Address = "$J$6" Then
                      If Target = "" Then Exit Sub
                          With Sheet1
                              i = Application.Match([d6], .Columns(1), 0)
                              If [h6] <> "BASE" Then
                                  ii = Application.Match("ChkPt " & [h6], .Rows(7), 0)
                              End If
                              iii = Application.Match("TimeOut", .Rows(7), 0)
                          End With
                      If [q6] = "" And [l6] = "" Then
                          If [d6] <> "" And [f6] <> "" And [h6] <> "" Then
                              If UCase([h6]) = "BASE" Then
                                  Sheet1.Cells(i, iii - 1) = [j6]
                              Else
                                  Sheet1.Cells(i, ii) = [j6]
                              End If
                          Else
                              MsgBox "Please ensure Rider No., Leg and Checkpoint are entered.", 16, "Missing Data"
                              [f6] = ""
                              Exit Sub
                          End If
                      ElseIf [q6] = "" And ([l6] = "V" Or [l6]) = "W" Then
                          If UCase([h6]) = "BASE" Then
                              Sheet1.Cells(i, iii - 1) = [l6]
                          Else
                              Sheet1.Cells(i, ii) = [l6]
                          End If
                      ElseIf [q6] <> "" And [j6] = "" And [l6] = "" Then
                          Sheet1.Cells(i, iii) = [q6]
                      ElseIf [q6] <> "" And [j6] <> "" Then
                          If [d6] <> "" And [f6] <> "" And [h6] <> "" Then
                              If UCase([h6]) = "BASE" Then
                                  Sheet1.Cells(i, Sheet1.Columns.Count).End(xlToLeft) = [j6]
                              Else
                                  Sheet1.Cells(i, ii) = [j6]
                              End If
                          Else
                              MsgBox "Please ensure Rider No., Leg and Checkpoint are entered.", 16, "Missing Data"
                              [f6] = ""
                              Exit Sub
                          End If
                      ElseIf [q6] <> "" And [j6] = "" And ([l6] = "V" Or [l6] = "W") Then
                          Sheet1.Cells(i, ii) = [l6]
                      End If
                      ClearOpen
                  End If
                  
               End Sub
              Note I moved the other procedures there into a standard module
              Attached Files
              We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

              Comment


              • #8
                Good Afternoon

                I have attached a sample file called "Enduro_2_Short.xlsm" this is a cut down file.

                On that file when you enter a number in D6, the enter a checkpoint number in H6, F6 will display the checkpoint number.

                That function is missing off the new file.

                What steps do I need to do to get Rider No 1 with Checkpoint 1 and time of 06:25 information over to the Open sheet cell E8 please
                Attached Files

                Comment


                • #9
                  when you enter a number in D6, the enter a checkpoint number in H6, F6 will display the checkpoint number
                  That does not happen, anyway since F6 shows which leg of the race is current why would you want a checkpoint number there?
                  We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

                  Comment


                  • #10
                    HI KJBox may I have your name please.

                    OK Yes I can see your point there, F6 just displays the leg of the race in relation to the H6 entry It should not be part of your programming.

                    I have entered 1 in D6, 1 in F6, 1 in H6, and 05:45 in J6, what do I need to do now, to get that across to the OPEN sheet in Row 14 Cell E14 please.

                    Comment


                    • #11
                      OK, here is a new version of the file. Note changes to N6 and Q6 on Front sheet.

                      The steps you need to take are
                      1. Enter the Rider No. in D6 - a check is made to ensure the rider has not withdrawn, if still in race then the Leg in F6 is automatically filled in (1 or 2);
                      2. Either enter the checkpoint number in H6, then enter either the time in J6 or "V" or "W" in L6 - if J6 or L6 is completed without a checkpoint number being entered then you will get a warning message;
                      3. Or enter the time 2nd leg started in N6
                      Press "enter" after entering data in J6, L6 or N6, the Open sheet will have relevant data entered and you will get a message to say the Open sheet has been successfully updated. The data entry cells on the Front sheet will clear ready for the next data entry.

                      Code now in the Front Worksheet Object Module is
                      Code:
                      Option Explicit
                      
                      Private Sub Worksheet_Change(ByVal Target As Range)
                          Dim x, e, i As Long, ii As Long, iii As Long
                          
                          If Target.Count > 1 Then Exit Sub
                      
                          If Target.Address = "$D$6" Then
                              If Target = "" Then Exit Sub
                              With Sheet1
                                  i = Application.Match([d6], .Columns(1), 0)
                                  iii = Application.Match("TimeOut", .Rows(7), 0)
                                  x = Sheet1.Rows(i).Resize(, 26)
                                  For Each e In x
                                      If e = "V" Or e = "W" Then
                                          MsgBox "Rider No. " & [d6] & " has withdrawn", 16, "Rider withdrawn"
                                          clearopen
                                          Exit Sub
                                      End If
                                  Next
                                  If .Cells(i, iii) = "" Then [f6] = 1 Else [f6] = 2
                              End With
                              Exit Sub
                          ElseIf Target.Address = "$J$6" Then
                              If Target = "" Then Exit Sub
                              If [d6] = "" Then
                                  MsgBox "Please enter Rider No.", 16, "Missing Data"
                                  [j6].ClearContents: Exit Sub
                              End If
                              With Sheet1
                                  i = Application.Match([d6], .Columns(1), 0)
                                  If UCase([h6]) <> "BASE" Then
                                      ii = Application.Match("ChkPt " & [h6], .Rows(7), 0)
                                  End If
                                  iii = Application.Match("TimeOut", .Rows(7), 0)
                              End With
                              If [f6] = 1 And [l6] = "" Then
                                  If [h6] <> "" Then
                                      If UCase([h6]) = "BASE" Then
                                          Sheet1.Cells(i, iii - 1) = [j6]
                                      Else
                                          Sheet1.Cells(i, ii) = [j6]
                                      End If
                                  Else
                                      MsgBox "Please enter Checkpoint.", 16, "Missing Data"
                                      [j6].ClearContents: Exit Sub
                                  End If
                              ElseIf [f6] = 2 Then
                                  If [h6] <> "" Then
                                      If UCase([h6]) = "BASE" Then
                                          Sheet1.Cells(i, Sheet1.Columns.Count).End(xlToLeft) = [j6]
                                      Else
                                          Sheet1.Cells(i, ii) = [j6]
                                      End If
                                  Else
                                      MsgBox "Please enter Checkpoint.", 16, "Missing Data"
                                      [j6].ClearContents: Exit Sub
                                  End If
                              End If
                              GoTo AllDone
                          ElseIf Target.Address = "$L$6" Then
                              If Target = "" Then Exit Sub
                              If [d6] = "" Then
                                  MsgBox "Please enter Rider No.", 16, "Missing Data"
                                  [j6].ClearContents: Exit Sub
                              End If
                              With Sheet1
                                  i = Application.Match([d6], .Columns(1), 0)
                                  If UCase([h6]) <> "BASE" Then
                                      ii = Application.Match("ChkPt " & [h6], .Rows(7), 0)
                                  End If
                                  iii = Application.Match("TimeOut", .Rows(7), 0)
                              End With
                              If [l6] = "V" Or [l6] = "W" Then
                                  If [f6] = 1 Then
                                      If UCase([h6]) = "BASE" Then
                                          Sheet1.Cells(i, iii - 1) = [l6]
                                      Else
                                          Sheet1.Cells(i, ii) = [l6]
                                      End If
                                  ElseIf [f6] = 2 Then
                                      Sheet1.Cells(i, ii) = [l6]
                                  End If
                              End If
                              GoTo AllDone
                          ElseIf Target.Address = "$N$6" Then
                              If Target = "" Then Exit Sub
                              If [d6] = "" Then
                                  MsgBox "Please enter Rider No.", 16, "Missing Data"
                                  [j6].ClearContents: Exit Sub
                              End If
                              If [d6] = "" Then
                                  MsgBox "Please enter Rider No.", 16, "Missing Data"
                                  [n6].ClearContents: Exit Sub
                              End If
                              With Sheet1
                                  i = Application.Match([d6], .Columns(1), 0)
                                  iii = Application.Match("TimeOut", .Rows(7), 0)
                                  .Cells(i, iii) = [n6]
                                  [d6] = 2
                              End With
                              GoTo AllDone
                          Else
                              Exit Sub
                          End If
                              
                      AllDone:
                          MsgBox "Open sheet successfully updated", 64, "Update completed"
                          clearopen
                              
                       End Sub
                      Attached Files
                      We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

                      Comment


                      • #12
                        H Charles

                        Thank you for you efforts so far,

                        My observations:

                        On the attached file I have put in the option of a 3 leg race, it would be rare depends on weather and track conditions.

                        1/ We need the option that a rider may be Vetted out or Withdrawn before the race actually starts, so that in involves Column "C"
                        2/ Lets assume that a rider has the first leg and is going out for the second leg THEY MUST HAVE a 1 hour REST you can see in The OPEN cells J11 and O11 the TEMP data there
                        3/ When they enter BASE in H6 can the code scan for the last occupied cell for that rider then enter the BASE or TIMEout

                        On a personal note please let me have your paypal account for some extra payments.

                        Peter
                        Attached Files

                        Comment


                        • #13


                          Hi Charles

                          For extra payment

                          Please look at the attached file (Enduro_Name) I have added to areas for the operator toe enter names for the riders, in sequential order,, OR optional Rider VEST number for Open and TRG

                          Peter
                          Attached Files

                          Comment

                          Working...
                          X