Formula or VBA code to do Data Entry in Hidden and protected Sheet from Data entry Sheet

Rahulkr

Board Regular
Joined
Dec 10, 2019
Messages
66
Office Version
  1. 2010
Platform
  1. Windows
Hi Everyone, Happy New year to all Great ones.
Please help in achieving my task, I have tried to some macros and some vba code to do some work in this workbook, actually I have prepared this excel for stock and inventory management as per our requirement. In this workbook user can do following task:-
1. first select entry type, either purchase or stock out from dropdown list
2. do entries and press on purchase or stock out shape accordingly. If press purchase then automatically data will go on purchase sheet and save it and return back to home sheet for new entry and so on for same as stock out also.
3. macro should automatically save data after each entry.
4. user can navigate in every sheet, but all sheets should be password protected to avoid any manipulation.
5. and if any cell in Home sheet is blank as per purchase or stock out criteria then macro should not run and throw message for either purchase or stock out.

But still I am getting errors and not able to achieve the task.

Each sheets password is 123 and VBA project password is 1236.

Any help is highly appreciated. Thanks a lot!

Some codes and macros which I have tried

In home sheet, for hidding the sheets and for combobox
VBA Code:
Private Sub ComboBox2_GotFocus()
ComboBox2.ListFillRange = "DropDownList"
ComboBox2.DropDown
End Sub

Private Sub Worksheet_Activate()
Dim ws As Worksheet

For Each ws In ThisWorkbook.Sheets
If ActiveSheet.Name <> ws.Name Then
ws.Visible = False
End If
Next ws

End Sub



Usings shapes, tried to navigate between all sheets.

VBA Code:
[CODE=xls]
Sub JumpToSheet()
    Dim shp As Shape

    Set shp = ActiveSheet.Shapes(Application.Caller)
    With Worksheets(shp.Name)
        .Visible = True
        .Select
    End With
End Sub
[/CODE]

and macros to copy and paste the data in hidden and protected sheets

VBA Code:
Sub pur()
'
' pur Macro
'

'
    Range("E10:E14").Select
    Sheets("HOME").Select
    Sheets("PURCHASE").Visible = True
    ActiveSheet.Unprotect
    Sheets("HOME").Select
    Selection.Copy
    Sheets("HOME").Select
    Sheets("PURCHASE").Visible = True
    Range("A5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A5").Select
    Application.CutCopyMode = False
    Selection.ListObject.ListRows.Add (1)
    Range("A5").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("HOME").Select
    Selection.ClearContents
    Range("E10").Select
    ActiveWorkbook.Save
End Sub
Sub stout()
'
' stout Macro
'

'
    Range("E10:E13").Select
    Sheets("HOME").Select
    Sheets("STOCK OUT").Visible = True
    ActiveSheet.Unprotect
    Range("A5").Select
    Sheets("HOME").Select
    Selection.Copy
    Sheets("HOME").Select
    Sheets("STOCK OUT").Visible = True
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A5").Select
    Application.CutCopyMode = False
    Selection.ListObject.ListRows.Add (1)
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("HOME").Select
    Selection.ClearContents
    Range("E10").Select
    ActiveWorkbook.Save
End Sub

This is the file link where you can see the full file
STATIONARY INVENTORY AND STOCK.xlsm
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
Try the following macro for the "PURCHASE" button. It is not necessary to make the sheet visible.
The macro does the following:
- Verify the data.
- unprotect the sheet
- add a row to the end of table2
- copy the data
- Protect the sheet again.

Try to replicate the code for the "STOCK OUT" button.

VBA Code:
Sub pur()
  Dim r As Range, c As Range
  Dim iRow As Long
  
  Set r = Range("E10:E14")
  For Each c In r
    If c.Value = "" Then
      MsgBox "Data is missing: " & c.Offset(, -1)
      Exit Sub
    End If
  Next
  With Sheets("PURCHASE")
    .Unprotect "123"
    With .ListObjects("Table2")
      .ListRows.Add AlwaysInsert:=True
      iRow = .DataBodyRange.Rows.Count
      .DataBodyRange(iRow, 1).Resize(1, 5).Value = Application.Transpose(r.Value)
    End With
    .Protect "123"
  End With
End Sub
 
Upvote 0
Try the following macro for the "PURCHASE" button. It is not necessary to make the sheet visible.
The macro does the following:
- Verify the data.
- unprotect the sheet
- add a row to the end of table2
- copy the data
- Protect the sheet again.

Try to replicate the code for the "STOCK OUT" button.

VBA Code:
Sub pur()
  Dim r As Range, c As Range
  Dim iRow As Long
 
  Set r = Range("E10:E14")
  For Each c In r
    If c.Value = "" Then
      MsgBox "Data is missing: " & c.Offset(, -1)
      Exit Sub
    End If
  Next
  With Sheets("PURCHASE")
    .Unprotect "123"
    With .ListObjects("Table2")
      .ListRows.Add AlwaysInsert:=True
      iRow = .DataBodyRange.Rows.Count
      .DataBodyRange(iRow, 1).Resize(1, 5).Value = Application.Transpose(r.Value)
    End With
    .Protect "123"
  End With
End Sub
Thank you DanteAmor you are amazing, I tried it's working, but what I found that the home sheet data is still there, which needs to be cleared once the data entry done. Can you please suggest me what should I do on that .
 
Upvote 0
Many Many Thank you DanteAmor

Most of the task I was able to achieve through your support, but now I have added one Marquee in the home sheet, it is woking also, but when navigating with other sheets, I am getting error. Can you please help me on this.

and here is the new file link which I have done.
New modified file link to download
 

Attachments

  • error.JPG
    error.JPG
    23.7 KB · Views: 9
Upvote 0
After these lines:
VBA Code:
    .Protect "123"
  End With

Put this line:
VBA Code:
r.ClearContents
Thank you very much DanteAmor, it really worked, but still MARQUEE is not working, it stopped when navigating with other sheets and when doing data entry, can you please help me on that.
 
Upvote 0
Thank you very much DanteAmor, it really worked, but still MARQUEE is not working, it stopped when navigating with other sheets and when doing data entry, can you please help me on that.
I changed the password for sheets as 1236 and for project 7986
 
Upvote 0
Thank you very much DanteAmor, it really worked, but still MARQUEE is not working, it stopped when navigating with other sheets and when doing data entry, can you please help me on that.
I don't understand what you mean by "Marquee". Is it another macro?
If it's another macro, you should close this thread and create a new one for a new topic.
 
Upvote 0
I don't understand what you mean by "Marquee". Is it another macro?
If it's another macro, you should close this thread and create a new one for a new topic.
Sorry DanteAmor, if you were not able to understand. Actually in the home sheet, in B5 cell I have some text, which I needs to be moving whenever the excel file opens, but when I am trying to navigate with another sheets, then error is coming.

Here is the code which I am using for moving text in one Cell b5.

VBA Code:
Sub DoMarquee()

For i = 1 To 1
        marq = marq & " !! Please Select Proper Entry Type Before Doing Entry .!!" & Cells(i, 1)
    Next
    marq = WorksheetFunction.Rept("", 300 - Len(marq)) & marq
    Sheets("HOME").Range("b5") = marq

    Do
        For i = 1 To Len(marq)
            DoEvents
            For a = 1 To 4999999
                a = a + 1
            Next
            Sheets("HOME").Range("b5") = Left(marq, i)
        
            
        Next
    Loop
End Sub

And just I have called this function in This workbook module, which is actually working, but when navigating to another Sheet then I am getting the error.
VBA Code:
Option Explicit
Private Sub Workbook_Open()
DoMarquee
End Sub

and the error what I am getting is this

1641395571242.png


and when Debuging it, it highlights the below code, I am not able to understand what I am missing. So, if possible, can you please help me on this.

1641395691152.png


I hope now you can understand. Many many thanks.
 
Upvote 0

Forum statistics

Threads
1,214,827
Messages
6,121,816
Members
449,049
Latest member
cybersurfer5000

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top