Vba code help

[StevieGis01]

Hi, I’ve been tasked with creating a parts spreadsheet in work, so for the past six weeks I have itemised over 2000 parts. After completing the data input I’ve set about making it more user friendly, but have been beaten by my limits on vba. I have manage to 3 vba codes to preform different tasks across 4 mains worksheets (parts list, re-order report, parts movement, catalogue). I’ve made over 4000 function buttons to preform 2 different tasks. 2000 increase parts list cells (Q1:Q2000) by +1 if. clicked. The other 2000 buttons decrease the same cells by -1 if clicked. My third code is also a button which runs a re order report by searching for the word YES in cells (R1:R2000) then copying the rows and populating them into the reorder sheet. But while running my spreadsheet within my maintenance team I encountered a problem, I have no record of parts movement. For the past week I’ve tried and tried and searched the internet but have came up short, in my search a and code building. I need a code to Automatically (no buttons) read cells(Q1:Q2000) for any change (these cells are increased and decreased by 1 with each click of the 2000 add buttons and 2000 remove buttons. The code then needs to copy each row in which the Q cell has increased or decreased (cells A to L) and paste them into parts movement sheet starting in row 5 and pasting into cells ( A to L) . The code also needs to allow the pasted rows to stay and to just create another row if the same part has been increased or decreased. I also need the pasted rows in parts movement sheet to be Timestamped this would allow a history for both used and restocked parts.

[#2]

@StevieGis01 My first thought is that a spreadsheet with 4000 (!) buttons is overwhelming. Especially when you are talking about "only" 2000 parts to track. There must be a simpler way, although I do not know how you have structured your data or what exactly you are asked to deliver.

I would probable start having a parts table and a transactions table and link them together using one of Excel's LOOKUP functions, Pivot Tables and/or Power Query / Power Pivot, and do the reporting (plus and minus and history) from there. But again, I have no idea about your real life situation. So, perhaps my thoughts are completely out of line.

[#3]

Hi 

@Riny_van_Eekelen Thankyou for your replay, I forgot to mention that im not very good with computers I'm just an electrician. What you said made me rethink my parts. I've now drastically reduced my parts list down to a maximum of 200 across 12 different spreadsheets (1 for each of our machines). 

All my machine spreadsheets are set out the same way, as follows

1. Parts List (Sheet1)

2. Reorder Parts Report (Sheet2)

3. Parts Removed (Sheet3)

4. Parts Added(Sheet4)

The parts list (Sheet1) has a max of 200 rows, each row uses cells (A:S),

On sheet1 I've made a vba button to run a reorder parts report. When clicked the code unlocks sheet1, clears all cells in sheet2, looks for "YES" within cells (R:R200), it then copies the rows cells(A:L,Q,R,S) from sheet1, pastes the rows onto the parts reorder report sheet (Sheet2), then locks sheet1 again.

Within all sheet1 cells (o) I've made a vba button to unlock sheet1, then reduce the value in cell (Q) by 1, then copy cells (A:L,Q,R,S) of the same row and paste them into Sheet3 in the next available row, then return back to sheet1 cell (A) of the same row which had been reduced, and lock sheet1 again.

Within all sheet1 cells (p) I've made a vba button to unlock sheet1, then increase the value in cell (Q) by 1, then copy cells (A:L,Q,R,S) of the same row and paste them into Sheet4 in the next available row, then return back to sheet1 cell (A) of the same row which had been reduced, and lock sheet1 again.

If Possible could you help me with tidying up my already made vba and give and also help me to create a time stamp in cell(o) for both sheet3 and sheet4 for each row that pastes to give me some sort of parts tracking.

My vba codes are

Public Sub RunReOrderReport()

'

'       Clear Re Order Sheet First

'       Run Re Order Count

'       Based On Re Order Colum "YES" OR " NO"

'       Copy Row and Paste on to Re order Sheet

'       Continue Though Sheet Until Complete

'       End

'

    ThisWorkbook.Worksheets("Parts List").Unprotect ("Password") ' Unlock Sheet

    Sheets("Re Order Parts Report").Cells.Clear 'Clear Re Order Sheet

    Dim c As Range

    Dim j As Integer

    Dim Source As Worksheet

    Dim Target As Worksheet

'

'       Source "Parts List" ("Sheet1")

'       Target "Re Order Parts Report" ("Sheet2")

'

    j = 2   'Start Copying To Row 2 In Target Sheet          

                Set Target = ThisWorkbook.Worksheets("Re Order Parts Report")               

'       For Each c In

                Set Source = ThisWorkbook.Worksheets("Parts List")         

        For Each c In Source.Range("G1:G1000")      

'        Do 1000 Rows 

            If c = "YES" Then           

'        ("Shee1"),Range.Value = "YES" = TRUE     

               ' Source , ThisWorkbook.Worksheets("Sheet1").Rows.c, Copy.Row = 2, Copy.Target.Rows(j)               

                  Source.Rows(c.Row).Copy Target.Rows(j)

                j = j + 1

            End If

        Next c

    ThisWorkbook.Worksheets("Parts List").Protect ("Password")

End Sub

Public Sub MinusOnePartClickButtonTest()
'
' PartsRemoved Macro
' if -1 button clicked copy stock and row to parts removed sheet
'
ThisWorkbook.Worksheets("Parts List").Unprotect ("Password") ' Unlock Sheet
Sheets("Parts List").Select
Range("F8").Value = Range("F8").Value - 1
Range("A8,F8").Select
Range("F8").Activate
Selection.Copy
Sheets("Parts Removed").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
ActiveSheet.Paste
Sheets("Parts List").Select
Range("A8").Select
Application.CutCopyMode = False
Range("A8").Select
ThisWorkbook.Worksheets("Parts List").Protect ("Password") ' Lock Sheet
End Sub

Public Sub AddOnePartClickButtonTest()
'
' PartsRemoved Macro
' if -1 button clicked copy stock and row to parts removed sheet
'
ThisWorkbook.Worksheets("Parts List").Unprotect ("Password") ' Unlock Sheet
Sheets("Parts List").Select
Range("F8").Value = Range("F8").Value + 1
Range("A8,F8").Select
Range("F8").Activate
Selection.Copy
Sheets("Parts Added").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
ActiveSheet.Paste
Sheets("Parts List").Select
Range("A8").Select
Application.CutCopyMode = False
Range("A8").Select
ThisWorkbook.Worksheets("Parts List").Protect ("Password")
End Sub

I Hope this makes sense  as I couldn't figure out how to make my vba look the same as everybody else's post's on here

Thanks again

[#4]

@StevieGis01 Hi there! Thanks for sharing. Quite a bit of extra information to digest. Am preparing for a small road trip just now and don't know how much time I'll have to look into this over the next few days. In the meantime, perhaps someone else out here can have a look at it. In order to increase your chances for a response you can perhaps upload one of your files (for one machine). Replace any confidential information with some faked data though.

[#5 · Accepted solution]

@StevieGis01 

Cleaning up the code is often a matter of removing "select" and "activate" and joining whatever was selected/activated with the action. Instead of

Range("A1").Select

Selection.Value = 10

it can be shortened to just

Range("A1").Value = 10

Just my two cents, but since these two procedures have a lot of overlap, you could set up a third procedure to do the work and just pass it the value by which to increase/decrease the cell. And, if you had cells other than F8 that this process worked on, you could pass it the applicable cell(s) on the Parts List worksheet.

Or, you could have the user select the cells they want to increment/decrement and have the macro work on whatever range the user has selected?

Public Sub MinusOnePartClickButtonTest()
     ChangePartCount -1
End Sub

Public Sub AddOnePartClickButtonTest()
     ChangePartCount 1
End Sub

Public Sub ChangePartCount(changeValue As Integer)
     Dim destWkSht As Worksheet
     Dim destCell As Range
     Dim timeStampCell As Range
     
     
     On Error GoTo ErrHandler
     
     
     If changeValue < 0 Then
          Set destWkSht = Sheets("Parts Removed")
     ElseIf changeValue > 0 Then
          Set destWkSht = Sheets("Parts Added")
     Else
          Exit Sub
     End If
     
     
     With destWkSht
          Set destCell = .Range("A" & .Rows.Count).End(xlUp).Offset(1)
          Set timeStampCell = Intersect(.Range("O:O").EntireColumn, destCell.EntireRow)
     End With


     With ThisWorkbook.Worksheets("Parts List")
          .Unprotect ("Password") ' Unlock Sheet
          .Range("F8").Value = .Range("F8").Value + changeValue
          .Range("A8,F8").Copy destCell
          .Protect ("Password") ' Lock Sheet
     End With
     
     timeStampCell.Value = Now
     
     Application.CutCopyMode = False


ExitProc:
     Set destCell = Nothing
     Set destWkSht = Nothing
     Exit Sub
     
ErrHandler:
     MsgBox "Error " & Err.Number & ": " & Err.Description
     Resume ExitProc
     
End Sub

[#6]

Hi@JMB17 

Thankyou for your very swift reply, I've no doubt that your code is correct and I sound exactly what I was looking for.

However I'm sure I must be doing something wrong because I can't get the code to run on my system.

After reading your reply and looking through your code I'd realised I send you a mixture of 2 different spreadsheet details. I made the real spreadsheet but because I know very little about VBA I made a very small test spreadsheet to play around with so that I wouldn't mess up all my hard work and the cell destinations where from the test spreadsheet with the correct sheet names from the main spreadsheet. So I've included a copy of both the main spreadsheet (with any sensitive details removed) 

Also could you advise me on

Within my VBA (Sheet1.RunPartsReorderReport)

1. help me to only clear from row 2 downwards in my Run Reorder Parts Report (is clears the previous report before pasting the next)

2. How to only copy cells (A:L,Q,R,S) 

Your code is called (Sheet1.PartsInventoryPartTracker)

It runs about 80/90% of the code then stops at the line:

  MsgBox "Error " & Err.Number & ": " & Err.Description

I changed the Value Range From ("F8") To ("Q4:Q250")  and the copy Range from("A8,F8") To ("A:L,Q,R,S")           I hope this isn't the problem

[#7]

I'll take a look at it. But, it may have to wait until this weekend.

[#8]

No problem, thanks for all your help, I viewed the download I sent you and my -1&+1 buttons don’t work because I had the running when the original workbook was opened, but the codes for them are in the viewer,
Thanks again you great

[#9]

The range reference ("A8,F8") will work, but ("A:L,Q,R,S") will not (no worries, we can fix it).

I see that you have increment/decrement buttons in row 5, columns O and P. Are these buttons dedicated to row 5 (i.e. - in your master version, do you have buttons for each row that increment/decrement the current stock level only for the item in that specific row)? I guessing that is the case based on your original post regarding having 4k buttons for 2k parts.

If so, I would agree with Riny that seems pretty overwhelming. Particularly when you consider making updates (adding parts or removing discontinued parts), as each button is hardcoded to a specific row (so, if you insert/delete rows, you have to update the vba code for all of the cells that got moved up/down and delete/add buttons and their respective vba code).

If you are open to suggestions, I would just have 2 buttons (increment/decrement) above the column that change the stock quantity in the same row as the active cell. So, the user selects the row they want to change, then clicks the button, and the stock quantity changes in column Q of that same row. Then you are free to update your table w/o having to update any of your increment/decrement code.

[#10]

Yes that’s correct, I’ve 2 buttons in every row that control the stock level cell then copy the row to the appropriate sheet ie. -1 button go to parts removed sheet, and +1 button go to parts added. It was a nightmare creating all the buttons, but that’s all I knew at the time.

Your suggestion sounds perfect, but I wouldn’t even know where to start, would it be able when the cell is selected and the correct button clicked will the stock level change up or down depending on which button is pressed. Then after the level changes the row is copied the to appropriate sheet and time stamp the new row in the new sheet also? If all that is possible great, will this code still allow the run parts reorder report to work,

This sound like a lot of work for yourself on my behalf.

Any help any greatly appreciated, it’s nice to be able to speak with Vba guru, my google searches only throw back the same things but described differently.

Thanks again for all you help

[#11]

@StevieGis01 

See if the attached workbook does what you are looking to do.

I named the cells in the last row of the table header. Instead of referring to a range by it's address, Range("Q4"), you can refer to it also by it's name (if it is named), such as Range("Current_Stock") if cell Q4 is named "Current_Stock". The advantage is that if you modify your table (insert rows/columns or cut/paste columns so they are in a different order), your code can still find the named range whereas Range("Q4") will always refer to Q4 (it doesn't realize Q4 was moved because you inserted/deleted a row/column above or to the left of it).  

I also set up some constants in the code module that refer to the names of the header cells. So, if you change the names of the cells, you only have to update the constants that refer to them. 

I added two forms buttons (not activex buttons), which are named "DecrementButton" and "IncrementButton" at the top of the current stock column. Both of these buttons are assigned to the macro "ChangeStockButton_Click." The macro will check the name of the button that called it and increment/decrement the current stock in the same row as the active cell (you don't have to actually be in column Q, just on the same row).

Then, "ChangeStockButton_Click" will call "CopyInvChange," which will copy the row of the item that was changed (excluding the min, initial, removed, and added fields) to the "Parts Added" or "Parts Removed" worksheets.

Note that worksheets actually have two names - tab name and code name. If you look at the worksheets listed in vba's project explorer window (view\project explorer), the code name is the first name listed and the tab name is in parentheses. Instead of Worksheets("Parts List").Range("A1"), you could use Sheet1.Range("A1"). That way, when users change the worksheet tab name, your code is not affected.

Excel has quite a few tools for referring or navigating worksheet ranges. As much as possible, I try to avoid referring to ranges by their actual cell address so your macros are more flexible to changes made to the worksheet. These are a few that I used:

CurrentRegion - refers to a region, such as a table. In this file, refers to A1:S209

UsedRange - refers to a worksheets "used range." Instead of looping through all of the cells in the entire column, you can limit your search to the used range (no point in checking all of the empty cells in the unused range).

Intersect - returns the range/cells in common  between two other ranges. Intersect(cell1.entirerow, cell2.entirecolumn) is one way to find the cell on the same row, but in another column.

Union - merges two or more ranges together (not on the worksheet itself, but your vba range variable).

[#12]

@StevieGis01 

Take a look at the file and see if that is what you have in mind. I added a worksheet with comments to provide some additional explanation of what I did. Hopefully, it makes sense.

Excel has quite a few ways to refer to worksheet ranges, instead of using their cell address, that can help make the vba procedures less susceptible to breaking because a user (or you) moved things around (like cut/paste the table fields because you want them to appear in a different order, or inserting rows above your header row, or deleting some rows/columns - depending on what's deleted).

[#13]

Hi
Yes everything that you’ve, done is exactly what I was hoping to achieve when I started out, and it works flawlessly on your file.
I’ve been trying from when you first sent the updated version to get it to work on the original which is on my company’s internal network (visible to everyone when they log in) but I can’t get it to work/run. The only Vba code I’ve got on the original file is your Vba and it’s on sheet1 just like your file. I started by firstly deleting everything to do with Vba from the original. After copying and pasting the new header names and layout from your to the original ( so they now look identical), I then copied and pasted the first 2 rows from yours to the original that then gave me the buttons and title, I then opened Visual Basic and made sure that there was no modules or anything that shouldn’t be there then is pasted your code to sheet1 of the Visual Basic. So now when I’ve got your version open on my laptop ant the original open on my work computer the only difference is that the original has a further 16 sheets ( a picture catalogue Of all the parts) but these sheets are not nothing to do with the Vba code so should have no bearing on the outcome of any of the Vba code running ( or so I think).
If I open design mode, right click on either the increment or decrement buttons in the original then click view code it takes me to ( Const procName As String = “ChangeStockButton_Click”). I get the same outcome on your version. If I do the same for the run parts reorder report button I get the same outcome but just with the destination (Const procName As String = “RunPartsReorderReport”) on both your version and the original.
If I click on the run parts reorder report button on your version (magic happens and the results populate to the correct sheet) if I do the same on the original I get an error (object variable or with block variable not set). If I go to the Visual Basic and position the cursor to the left of Public Sub ( for RunPartsReorderReport) click play I get (Run_time error ‘91’: Object variable or with block variable not set)

When I try the increment and decrement buttons on the original I get ( Error: 1004: Method ‘Range’ of object ’_Worksheet’ failed) when I go through the Visual Basic play method I get ( Error: 1004: Method ‘Range’ of object ’_Worksheet’ failed) but when I try both method on your version (magic everything works). So my guess is that again it’s my fault, I’ve definitely done something wrong that your Vba doesn’t like.
How would be the best way to correct these issues?

[#14]

Is it possible that you can upload a copy of the workbook that is misbehaving (you can remove the worksheets that comprise the picture catalog, anything that is sensitive, or even most/all of the parts list data if you need to)?

I should be able to figure out what it doesn't like and then help with some instructions to fix the original file.

[#15]

@JMB17 

here is a copy of the workbook, good luck, I think I was just being over cautious last time, as my company is really strict about the use of their computers, with the risk of viruses etc. so is there ant way for me to be able to update the original workbook. with the repaired workbook from yourself without the possibility of contaminating the original/ works company network? 

[#16]

@StevieGis01 

Yes. I believe all you need to do is name the cells in your header row (row 4) in the name manager.

If you look at my file, you'll see that I named all of the cells in Row 4 (click on a header cell in row 4 and you'll see the name in the name box). And if you look in the vba code near the top of the module, you will see a list of Private Const xxxxxxRngName = "xxxxxxxx".

But, I don't believe you will actually need all of them (I named the cells up front before writing any code, but it turns out I didn't actually use all of them). You will only actually need to name columns M through R.

I attached a screenshot of the six you need. To add the names on the excel worksheet side (walk you through the first one for the Min Stock column)

1) click on the Parts List tab
2) click on Formulas\Name Manager
3) select New
4) Name (see screenshot - the name I used will be on the right of the = sign): Stock_Min
Scope: Parts List
Refers to: ='Parts List'!$M$4 (or click on the little arrow button to right of the box and select cell M4).
5) click OK

Then, repeat for the other five.

[#17]

Your fantastic, everything is working correctly now

I can't thankyou enough,

Is there anything I can do to say thankyou?

[#18]

Thank you is plenty. I'm glad to see you got it working.

[#19]

Sorry me again, hopefully this is the last issue, I was going through the workbook with the boss showing him all your hard work and come across a wee hiccup. Because I need the sheets locked to stop to stop them from being changed. I had locked them all and when I click any of the buttons the code runs but will not paste to the destinations unless they are unlocked, I dose tell you that in a message window though. But the stock still increases or decreases without the paste, the reorder report runs (I think) But again no paste unless the reorder sheet is unlocked. I know that makes sense, But is there a way to unlock the destination sheets and relight them again within the same code

[#20]

@StevieGis01 

Yes. I modified the Reorder Parts and Change Inventory macros to also unlock/relock the destination worksheets. You should be able to copy/paste this revised code from the Parts List module into your workbook. 

I'm assuming the worksheets all use the same password, which you may have noticed is defined by the constant at the top of the module (PWord). I think it is currently set to vbnullstring, but change that to whatever you need (enclosed in quotes, Const PWord As String = "MyPassword")

Make a copy/backup of your file, just in case.