Add New AFR Number With Password Protection Thru VBA

[fredfarmer]

Hello,

Cell F2 on the 'AFRsInput' sheet is currently a drop down list. Could this be an input cell instead and not have the drop down list?

I would like to enter a number here and it pulls up the record for that number and fills in all of the fields.

I would also like to if the number isn't there (from the 'AFRsDB' sheet column C) be able to enter a number of choosing. This should have a popup message saying something like: "Are you sure you want to add this new AFR#?" Then enter a password to verify.

Thank you very much in advance for your help,
FF

[alansidman]

Administrative Note:

Welcome to the forum.

We would very much like to help you with your query, however the thread title does not really convey what your request is about.
Please take a moment to amend your thread title. Make sure that the title properly explains your request. Your title should be explicit and not be generic (this includes function names used without an indication of what you are trying to achieve).

Please see Forum Rule #1 about proper thread titles and adjust accordingly. To edit the thread title, open the original post to edit and then click on Go Advanced (bottom right) to access the area where you can edit your title.

(Note: this change is not optional. No help to be offered until this moderation request has been fulfilled.)

[fredfarmer]

I changed the title is this satisfactory now?

[Richard Buttrey]

Thank you for your Q. Mr F.

Yes, I believe the change of title is perfectly satsisfactory. Thank you for making the change.

[fredfarmer]

I appreciate the reply and I am hoping to get some help. Have a great day sir!

[Arkadi]

Hi fredfarmer,

As far as the dropdown, I also assume you can remove that? (Data tab, drop down data validation, select data validation, change the "Allow" box to "any value".

This code will ask if the user wants to create a new AFR and then ask for a password if yes is chosen:

Sub PopulateForm()
    With ThisWorkbook
        Dim myPass As String: myPass = "password"
        Dim myPassRequest As String
        Dim myAnswer As Integer
        Dim rng As Range
        Dim rng2 As Range
        Dim i As Integer
        Dim wsSrc1 As Worksheet:    Set wsSrc1 = .Sheets("AFRsDB")
        Dim wsSrc2 As Worksheet:    Set wsSrc2 = .Sheets("AFRsParts")
        Dim wsTar As Worksheet:     Set wsTar = .Sheets("AFRsInput")
        Dim lngAFR As Long:         lngAFR = wsTar.Range("F2").Value
        Dim lngRow As Long
        Dim lngSrc2LR As Long
        Dim NewTblRow As ListRow
        
        Set rng = wsSrc1.Range("C:C").Find(lngAFR, , xlValues, xlWhole)
        If Not rng Is Nothing Then
            lngRow = rng.Row
            For i = 3 To 37
                Set rng2 = wsTar.Range("B4:J19").Find(wsSrc1.Cells(1, i).Value)
                rng2.Offset(0, 2) = wsSrc1.Cells(lngRow, i)
            Next i
                    
            On Error Resume Next
            wsTar.ListObjects("Table1").DataBodyRange.Delete
            On Error GoTo 0
            With wsSrc2
                lngSrc2LR = .Cells(Rows.Count, "A").End(xlUp).Row
                For i = 3 To lngSrc2LR
                    If .Cells(i, "C") = lngAFR Then
                        Set NewTblRow = wsTar.ListObjects("Table1").ListRows.Add
                        NewTblRow.Range(1) = .Cells(i, "C")
                        NewTblRow.Range(2) = .Cells(i, "D")
                        NewTblRow.Range(3) = .Cells(i, "E")
                        NewTblRow.Range(4) = .Cells(i, "F")
                    End If
                Next i
            End With
        Else
            If Worksheets("AFRsInput").Range("F2").Value = vbNullString Then Exit Sub
            myAnswer = MsgBox("Are you sure you want to add this new AFR#?", vbYesNo)
            If myAnswer <> vbYes Then Exit Sub
            myPassRequest = InputBox("Please enter the password to verify the new AFR #")
            If myPassRequest <> myPass Then
                MsgBox ("Sorry, that password is incorrect")
                Worksheets("AFRsInput").Range("F2").Value = vbNullString
                Exit Sub
            Else
                MsgBox ("New AFR # accepted.")
            End If
        End If
    End With
End Sub

[fredfarmer]

I really appreciate it again! The new AFR# isn't being put in the 'AFRsDB' sheet when selecting 'Update Data'. Do you know why not?

[Arkadi]

Oh because the update code does take into account that if the AFR number does not exist (rng is nothing) then the update row is the next row, but never actually posts the AFR number in there. So change this part of the update code (CommandButton1_Click):

If Not rng Is Nothing Then
    UpdateRow = rng.Row
Else
    UpdateRow = .Cells(Rows.Count, "C").End(xlUp).Row + 1
End If

To:

If Not rng Is Nothing Then
    UpdateRow = rng.Row
Else
    UpdateRow = .Cells(Rows.Count, "C").End(xlUp).Row + 1
    .Cells(UpdateRow, "C").Value = wsTar.Range("F2").Value
End If

[Arkadi]

Actually... here is a correction for dealing with clearing the sheet if a blank AFR is entered:

Sub PopulateForm()
    With ThisWorkbook
        Dim myPass As String: myPass = "password"
        Dim myPassRequest As String
        Dim myAnswer As Integer
        Dim rng As Range
        Dim rng2 As Range
        Dim i As Integer
        Dim wsSrc1 As Worksheet:    Set wsSrc1 = .Sheets("AFRsDB")
        Dim wsSrc2 As Worksheet:    Set wsSrc2 = .Sheets("AFRsParts")
        Dim wsTar As Worksheet:     Set wsTar = .Sheets("AFRsInput")
        Dim lngAFR As Long:         lngAFR = wsTar.Range("F2").Value
        Dim lngRow As Long
        Dim lngSrc2LR As Long
        Dim NewTblRow As ListRow
        
        If Worksheets("AFRsInput").Range("F2").Value = vbNullString Then
            Worksheets("AFRsInput").Range("D4:D18").ClearContents
            Worksheets("AFRsInput").Range("H4:H18").ClearContents
            Worksheets("AFRsInput").Range("L4").MergeArea.ClearContents
            Worksheets("AFRsInput").Range("L7").MergeArea.ClearContents
            Worksheets("AFRsInput").Range("L10").MergeArea.ClearContents
            Worksheets("AFRsInput").Range("L13").MergeArea.ClearContents
            Worksheets("AFRsInput").Range("L19").MergeArea.ClearContents
            wsTar.ListObjects("Table1").DataBodyRange.Delete
            Exit Sub
        End If
        
        Set rng = wsSrc1.Range("C:C").Find(lngAFR, , xlValues, xlWhole)
        If Not rng Is Nothing Then
            lngRow = rng.Row
            For i = 3 To 37
                Set rng2 = wsTar.Range("B4:J19").Find(wsSrc1.Cells(1, i).Value)
                rng2.Offset(0, 2) = wsSrc1.Cells(lngRow, i)
            Next i
                    
            On Error Resume Next
            wsTar.ListObjects("Table1").DataBodyRange.Delete
            On Error GoTo 0
            With wsSrc2
                lngSrc2LR = .Cells(Rows.Count, "A").End(xlUp).Row
                For i = 3 To lngSrc2LR
                    If .Cells(i, "C") = lngAFR Then
                        Set NewTblRow = wsTar.ListObjects("Table1").ListRows.Add
                        NewTblRow.Range(1) = .Cells(i, "C")
                        NewTblRow.Range(2) = .Cells(i, "D")
                        NewTblRow.Range(3) = .Cells(i, "E")
                        NewTblRow.Range(4) = .Cells(i, "F")
                    End If
                Next i
            End With
        Else
            myAnswer = MsgBox("Are you sure you want to add this new AFR#?", vbYesNo)
            If myAnswer <> vbYes Then Exit Sub
            myPassRequest = InputBox("Please enter the password to verify the new AFR #")
            If myPassRequest <> myPass Then
                MsgBox ("Sorry, that password is incorrect")
                Worksheets("AFRsInput").Range("F2").Value = vbNullString
                Exit Sub
            Else
                MsgBox ("New AFR # accepted.")
            End If
        End If
    End With
End Sub

[Arkadi]

Nope no idea, didn't look at the code for the buttons, but will take a peek

[fredfarmer]

You are truly amazing thanks so much!!!

[Arkadi]

Happy to help, thanks for the kind feedback

[fredfarmer]

I found if I delete the parts entirely where there aren't any in the AFRsInput sheet then select 'Update Data' it doesn't remove those parts from the 'AFRsParts' sheet.

[Richard Buttrey]

I found if I delete the parts entirely where there aren't any in the AFRsInput sheet then select 'Update Data' it doesn't remove those parts from the 'AFRsParts' sheet.

Could you just clarify please.

From which sheet sheet are you deleting the parts how are you doing or wanting to do that?

[Arkadi]

Because you abort the code if O3 = 0

I am swamped at work atm and can't work on it until tomorrow morning probably, but will work on it if you still need me to do so in the morning. The key is to check if O3 = 0 AND the AFR is not listed on the parts sheet.

[fredfarmer]

Okay I will try thanks .

[fredfarmer]

Hello and thank you for help in advance.

The AFRsInput sheet is like a form and the AFRsDB & AFRsParts store the data.

When entering parts in the AFRsInput sheet then select the 'Update Data' button it should maintain the same parts either adding, changing, or deleting. The reference ID is the number is in D4 or column N on the AFRsInput sheet.

I thought column N was needed to sort of pin the parts to the correct AFR# is that correct? I want to hide that column but can't seem to do that and keep it functioning properly. I only want the cells for input to be unlocked so I can protect the sheet.

I eliminated cell F2 and changed all codes referencing cell D4 instead. It seem redundant with F2.

1) I would really appreciate advice on the protection of the AFRsInput Sheet also.
2) A way to prevent duplicate parts per AFR#. The user should just increase the quantity of the part instead of having the same part more than once.
3) Should the parts on the AFR# not have column N and maybe just a range instead of a table? The range from O3:Q23?

Perhaps I am asking too much?


I really do appreciate the help,
FF

[Arkadi]

Hi fredfarmer,

1. What do you mean by "protection"? Are there certain cells that you don't want the user to be able to change? Typically for this I would select all the cells on the sheet, go to format cells, protection tab, and make sure to uncheck "Locked". Then select those cells that you DON'T want the user to be able to modify, and mark those as "Locked". This has no effect until you protect the sheet, at which point the locked cells will not be able to be edited (or even selected) depending on what you select when you protect it. Then for any macro that updates that sheet, un-protect at the start of the code, and protect again at the end.

2. You can prevent duplicates in a number of ways. A change event on AFRsInput that checks column P for duplicates is one way to do this, or simply check for duplicates when the Update Data button is used. Or, don't even check for doubles, just use a Dictionary object, add each part and if it comes up a second time, then just increment the quantity.

3. Your call of using a table or just use ranges, the downside is that if the parts list goes past row 23, the presentation isn't as nice. Either way the code should look for last row I guess, rather than hard coding row 23 as the last row being looked at.
And yes, I would just not bother having the AFR number in column N, it has no value especially if you plan to have it hidden.

[fredfarmer]

Thanks for your time and effort in advance. I know you are busy.

1) I am aware of how to unlock the cells and protect the sheet but there seems to be interference with column N. So if this was taken away it would be better.

2) Not sure which way is best for duplicates. I suppose I could make a rule for the user or whatever you suggest is best.

3) I agree to keep it a table for extending parts if needed. If you can figure out how to eliminate the column N it would be best but also make sure the parts are allocated to the correct AFR#.

Oh forgot to mention the unlocked cells:

D4:D18, H4:H18, L4:L23, O3:Q23 maybe enough.

[Arkadi]

What do we do if a part number is listed twice in the Input sheet, but they have different POs?

[fredfarmer]

Thank you I did some testing and so far found that if I put parts on an AFR then update it posts to the AFRsParts sheet which is correct. If I delete those parts from the AFRsInput they are all removed except the first line. The AFRsParts still has the rows.

Also when the sheet is protected the table doesn't grow with parts it only does so when the sheet is unprotected.

Another strange thing happens. If I update it eliminates parts from other AFRs

[Arkadi]

"make sure the parts are allocated to the correct AFR#." That would always be D4 would it not?

[fredfarmer]

That is correct yes.

[fredfarmer]

Hmm very good point I didn't think of that. I suppose that could happen but not often.

In that case a quantity of 1 for one PO and quantity 2 for another PO could be a possibility.

Maybe it is best to not check for duplicates and leave it be. The User will have to pay attention to the details.

With Humans there are errors but we try to keep them to a minimum.

[Arkadi]

Ok, since a few modules were updated to un-protect and re-protect the sheet, I am attaching the workbook instead of just posting the code. I had to do some testing, so note that the data in the DB and Parts sheets have changed some.

[fredfarmer]

Take a look I tried the replacement. The AFRsParts don't reference the AFR #

[fredfarmer]

So far it is improving sir. I cannot add parts now. It seems when protected the table function is disabled.

I think this would be better without the table but the functioning isn't there.

[Arkadi]

Hmm, turns out the last row in column P was considered 3 because there is a table row there even though it is empty.

Try replacing

If LRPrts < 3 Then GoTo end_the_sub:

with

If LRPrts <= 3 And wsTar.Range("P3").Value = "" Then GoTo end_the_sub:

[fredfarmer]

I am so sorry to be trouble. Maybe I should close this thread I have taken up entirely too much of your time.

I appreciate all of the great help sir.

[Arkadi]

I must have forgotten to save the last time I worked on the file?

PartsLR2 should be based on column D not C since C is updated after:

prtsLR2 = .Cells(Rows.Count, "D").End(xlUp).Row

[fredfarmer]

I think maybe disable the table in VBA then convert to range. I can put borders on down to row 23 to make it look good.

[Arkadi]

That is an option yes. Not sure when I can get back on it though, have quite a bit to do today, and a funeral this weekend. Will post back when I have something.

This turned out to be more than just a little help.

[fredfarmer]

Very sorry for your loss and I appreciate everything take care sir.

[Arkadi]

You're welcome... I will help more, just may not be before Monday

[fredfarmer]

Here is the latest update without the table: