Macro/VBA For gathering info

A

Antonow

New Member
Joined
Aug 19, 2015
Messages
39
Hello World!

Well, it's been a while since i've been messing with excel VBA and Macros and now I need to develop something thus..
I need the help of the best ones there is!

Basically I have A Data worksheet, with several informations.
Like, factory code, dealer code, Number of the product, mainteneance.. stuff like that.
I need to make a new tab with something like, you input the Factory code, or the Products code and hits this search button.

The final product should give you all the info you need in that tab without having to go in the other ones. Like I can't remember how to make a VBA that looks in every line of a certain range and gives me the info I need.
I've tried to do it and it searches only the first line of every worksheet :(
Plus, i need to implement the possibility to add a new input, select in what worksheet it should go and press save.

I've done something like it but it was really waaaay back there.. can't remember how I've done it :(

I know it's a long shot, with a lot of try and error.. But hopefully we will be able to do it! :)

I will post more info about the worksheet here later. end of the month is a mess for everyone heh.

But I would be glad if you guys helped me out with some "generic" code for that.

Thank you all in advance!
 
Sort by date Sort by votes
My bad re. the mix up. Trial this. I provided some code at the end that U can trial to avoid using selection. Using selection is rarely needed and slows things down. Dave
Code: 
Sub Update()
Dim Lastrow As Integer, Cnt As Integer, Flag As Boolean
'data in "A2:A" & lastrow
Flag = False
With Sheets("Moulds")
    Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
For Cnt = 2 To Lastrow
If Sheets("Input").Range("C" & 14).Value = Sheets("Moulds").Range("A" & Cnt).Value Then
'move data here
'Supplier Code
Sheets("Moulds").Range("C" & Cnt).Value = Sheets("Input").Range("C" & 15).Value
'Factory
Sheets("Moulds").Range("E" & Cnt).Value = Sheets("Input").Range("C" & 16).Value
'Status
Sheets("Moulds").Range("F" & Cnt).Value = Sheets("Input").Range("C" & 17).Value
'Vulnerability
Sheets("Moulds").Range("G" & Cnt).Value = Sheets("Input").Range("C" & 18).Value
'Family
Sheets("Moulds").Range("H" & Cnt).Value = Sheets("Input").Range("C" & 19).Value
'Tooling
Sheets("Moulds").Range("I" & Cnt).Value = Sheets("Input").Range("C" & 20).Value
'Description
Sheets("Moulds").Range("B" & Cnt).Value = Sheets("Input").Range("G" & 14).Value
'S.O. Tooling
Sheets("Moulds").Range("J" & Cnt).Value = Sheets("Input").Range("G" & 16).Value
'H.C. Code
Sheets("Moulds").Range("K" & Cnt).Value = Sheets("Input").Range("G" & 17).Value
'H.C. Manufacturer
Sheets("Moulds").Range("L" & Cnt).Value = Sheets("Input").Range("G" & 18).Value
'H.C. Diameter
Sheets("Moulds").Range("M" & Cnt).Value = Sheets("Input").Range("G" & 19).Value
'Pendency
Sheets("Moulds").Range("N" & Cnt).Value = Sheets("Input").Range("G" & 20).Value
'Action
Sheets("Moulds").Range("O" & Cnt).Value = Sheets("Input").Range("K" & 16).Value
'Cost
Sheets("Moulds").Range("P" & Cnt).Value = Sheets("Input").Range("K" & 17).Value
'Internal/External Service
Sheets("Moulds").Range("Q" & Cnt).Value = Sheets("Input").Range("K" & 18).Value
'Execution Time (Internal Tooling)
Sheets("Moulds").Range("R" & Cnt).Value = Sheets("Input").Range("K" & 19).Value
'Tooling release
Sheets("Moulds").Range("S" & Cnt).Value = Sheets("Input").Range("K" & 20).Value
'Production release
Sheets("Moulds").Range("T" & Cnt).Value = Sheets("Input").Range("O" & 16).Value
'Product Criticy
Sheets("Moulds").Range("U" & Cnt).Value = Sheets("Input").Range("O" & 17).Value
'Proccess Criticy
Sheets("Moulds").Range("V" & Cnt).Value = Sheets("Input").Range("O" & 18).Value
'Quality history
Sheets("Moulds").Range("W" & Cnt).Value = Sheets("Input").Range("O" & 19).Value
'Volume
Sheets("Moulds").Range("X" & Cnt).Value = Sheets("Input").Range("O" & 20).Value
'Project
Sheets("Moulds").Range("D" & Cnt).Value = Sheets("Input").Range("S" & 14).Value
'Control Level
Sheets("Moulds").Range("Y" & Cnt).Value = Sheets("Input").Range("S" & 16).Value
'Mainance complexity
Sheets("Moulds").Range("Z" & Cnt).Value = Sheets("Input").Range("S" & 17).Value
'Preventive Level
Sheets("Moulds").Range("AA" & Cnt).Value = Sheets("Input").Range("S" & 18).Value
'%Recycled drawing
Sheets("Moulds").Range("AB" & Cnt).Value = Sheets("Input").Range("S" & 19).Value
'Hidraulich hitch
Sheets("Moulds").Range("AC" & Cnt).Value = Sheets("Input").Range("S" & 20).Value
'etc.
Flag = True
Exit For
End If
Next Cnt
If Not Flag Then
If MsgBox(prompt:="MOULD does not exist! Do you want to add MOULD?", _
           Buttons:=vbYesNo, Title:="ADD MOULD?") = vbYes Then
Sheets("Moulds").Range("A" & Lastrow + 1).Value = Sheets("Input").Range("C" & 14).Value
Else
MsgBox "Invalid Code"
Exit Sub
End If
End If
'Sheets("Moulds").Unprotect "Pass"
    ActiveSheet.Unprotect "Pass"
Selection.ClearContents
'Sheets("Moulds").Range("C14:D14").ClearContents
    Range("C14:D14").Select
    Range("C14:D20,G16:H20,K16:L20,O16:P20,S14:T20,G14:P15").Select
    Range("G14").Activate
    Selection.ClearContents
    Range("C14:D14").Select
    ActiveSheet.Protect "Pass", True, True
End Sub
 
Upvote 0

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Dave, one last question.

Let's say I don't want everyone messing with updating the sheet.
Is there a way that I can pop up a message after this code?

If MsgBox(prompt:="MOULD does not exist! Do you want to add MOULD?", _ Buttons:=vbYesNo, Title:="ADD MOULD?") = vbYes Then

If yes, ask for a password to unprotect the "Moulds" sheet and when it finishes doing it's thing it protects it auto?

Thanks
****** id="cke_pastebin" style="position: absolute; top: 0px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">If MsgBox(prompt:="MOULD does not exist! Do you want to add MOULD?", _ Buttons:=vbYesNo, Title:="ADD MOULD?") = vbYes Then</body>
 
Upvote 0
U can trial this...
Code: 
Sub Update()
Dim Lastrow As Integer, Cnt As Integer, Flag As Boolean, ShtPass As String
'data in "A2:A" & lastrow
Flag = False
With Sheets("Moulds")
    Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
For Cnt = 2 To Lastrow
If Sheets("Input").Range("C" & 14).Value = Sheets("Moulds").Range("A" & Cnt).Value Then
'move data here
'Supplier Code
Sheets("Moulds").Range("C" & Cnt).Value = Sheets("Input").Range("C" & 15).Value
'Factory
Sheets("Moulds").Range("E" & Cnt).Value = Sheets("Input").Range("C" & 16).Value
'Status
Sheets("Moulds").Range("F" & Cnt).Value = Sheets("Input").Range("C" & 17).Value
'Vulnerability
Sheets("Moulds").Range("G" & Cnt).Value = Sheets("Input").Range("C" & 18).Value
'Family
Sheets("Moulds").Range("H" & Cnt).Value = Sheets("Input").Range("C" & 19).Value
'Tooling
Sheets("Moulds").Range("I" & Cnt).Value = Sheets("Input").Range("C" & 20).Value
'Description
Sheets("Moulds").Range("B" & Cnt).Value = Sheets("Input").Range("G" & 14).Value
'S.O. Tooling
Sheets("Moulds").Range("J" & Cnt).Value = Sheets("Input").Range("G" & 16).Value
'H.C. Code
Sheets("Moulds").Range("K" & Cnt).Value = Sheets("Input").Range("G" & 17).Value
'H.C. Manufacturer
Sheets("Moulds").Range("L" & Cnt).Value = Sheets("Input").Range("G" & 18).Value
'H.C. Diameter
Sheets("Moulds").Range("M" & Cnt).Value = Sheets("Input").Range("G" & 19).Value
'Pendency
Sheets("Moulds").Range("N" & Cnt).Value = Sheets("Input").Range("G" & 20).Value
'Action
Sheets("Moulds").Range("O" & Cnt).Value = Sheets("Input").Range("K" & 16).Value
'Cost
Sheets("Moulds").Range("P" & Cnt).Value = Sheets("Input").Range("K" & 17).Value
'Internal/External Service
Sheets("Moulds").Range("Q" & Cnt).Value = Sheets("Input").Range("K" & 18).Value
'Execution Time (Internal Tooling)
Sheets("Moulds").Range("R" & Cnt).Value = Sheets("Input").Range("K" & 19).Value
'Tooling release
Sheets("Moulds").Range("S" & Cnt).Value = Sheets("Input").Range("K" & 20).Value
'Production release
Sheets("Moulds").Range("T" & Cnt).Value = Sheets("Input").Range("O" & 16).Value
'Product Criticy
Sheets("Moulds").Range("U" & Cnt).Value = Sheets("Input").Range("O" & 17).Value
'Proccess Criticy
Sheets("Moulds").Range("V" & Cnt).Value = Sheets("Input").Range("O" & 18).Value
'Quality history
Sheets("Moulds").Range("W" & Cnt).Value = Sheets("Input").Range("O" & 19).Value
'Volume
Sheets("Moulds").Range("X" & Cnt).Value = Sheets("Input").Range("O" & 20).Value
'Project
Sheets("Moulds").Range("D" & Cnt).Value = Sheets("Input").Range("S" & 14).Value
'Control Level
Sheets("Moulds").Range("Y" & Cnt).Value = Sheets("Input").Range("S" & 16).Value
'Mainance complexity
Sheets("Moulds").Range("Z" & Cnt).Value = Sheets("Input").Range("S" & 17).Value
'Preventive Level
Sheets("Moulds").Range("AA" & Cnt).Value = Sheets("Input").Range("S" & 18).Value
'%Recycled drawing
Sheets("Moulds").Range("AB" & Cnt).Value = Sheets("Input").Range("S" & 19).Value
'Hidraulich hitch
Sheets("Moulds").Range("AC" & Cnt).Value = Sheets("Input").Range("S" & 20).Value
'etc.
Flag = True
Exit For
End If
Next Cnt
If Not Flag Then
If MsgBox(prompt:="MOULD does not exist! Do you want to add MOULD?", _
           Buttons:=vbYesNo, Title:="ADD MOULD?") = vbYes Then
ShtPass = Application.InputBox("Enter Sheet Password.")
If ShtPass = False Then
MsgBox "No password entered!"
Exit Sub
End If
Sheets("Moulds").Unprotect Password:=ShtPass
Sheets("Moulds").Range("A" & Lastrow + 1).Value = Sheets("Input").Range("C" & 14).Value
Else
MsgBox "Invalid Code"
Exit Sub
End If
End If
'Sheets("Moulds").Unprotect "Pass"
    ActiveSheet.Unprotect "Pass"
Selection.ClearContents
'Sheets("Moulds").Range("C14:D14").ClearContents
    Range("C14:D14").Select
    Range("C14:D20,G16:H20,K16:L20,O16:P20,S14:T20,G14:P15").Select
    Range("G14").Activate
    Selection.ClearContents
    Range("C14:D14").Select
    ActiveSheet.Protect "Pass", True, True
End Sub
Dave
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question Question
VBA to populate cells on one worksheet with cells from another worksheet based on date help!!!
Replies
2
Views
360
Taekwon
T
D
  • Question Question
Linking comment cells to regularly changing info
Replies
3
Views
255
Dan5977
D
C
  • Solved
Help matching images in a folder to a worksheet
Replies
9
Views
188
Cruiser69
C
A
  • Solved
Need VBA to automatically copy paste rows based factory selected
Replies
8
Views
608
Alex Blakenburg
A
F
  • Question Question
[VBA Question]: Copy/paste every single quarter - replicate 40 times in a quarter
Replies
1
Views
55
StephenCrump
S

Forum statistics

Threads
1,223,910
Messages
6,175,318
Members
452,634
Latest member
cpostell

Share this page

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