Forum Discussion
Vba code help
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
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.
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 SubPublic 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 SubI 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
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 SubHiJMB17
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
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.
