Copper Contributor

Aug 18, 2020

Solved

Vba code help

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, ...

developer

Formulas and Functions

Macros and VBA

JMB17

Aug 19, 2020

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

StevieGis01

Copper Contributor

Aug 19, 2020

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

Riny_van_Eekelen

Platinum Contributor

Aug 19, 2020

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.

Forum Discussion

Vba code help

Resources