Find and past button

[_Fly_]

a

b

c

d

e

f

g

h

i

1

Number

2

Item

3

Stock

4

Condition

5

<tbody>
</tbody>

Sheet Entrance

	a	b	c	d
1	Number	Item	Stock	Condition
2	123456	Paper Case	100	New
3	234123	Chair	4	Used

<tbody>
</tbody>

Sheet Global

Hi my friends it's possible to help me on that issue?
I want to put a code on my button that appears on the Sheet Entrance that when i click appears a msgbox aske me for a number. Then i put the number and click ok, then the code searches on the sheet global for that code and if that number exists copy the interior of the correspondent cell on the column a, b, c and d to the Sheet entrance on the correspondent cells C1, C2, C3, C3. If the number doens't exists appear that info.

Example i click the button on the sheet Entrance and a msgbox appear ask me a number i insert the 234123 and click ok.
The code goes search for that number on A:A and finds on the A3 cell, so it copys the a3 value from Sheet Global to C1 Sheet Entrance, the b3 value from Sheet Global to the c2 Sheet Entrance, the c3 value from Sheet Global to the d3 Sheet Entrance, the d3 value from Sheet Global to the c4Sheet Entrance.

It's possible to give me any ideas to the code?
Regards

 

[_Fly_]

its not only that also the limits appear grey and the blue box desappear....

But please i discovered a new error the code i have added work's well but now if i insert a number that isn't on the CodigoI the msg box don't appear. Please see my explanation her.

http://www.mrexcel.com/forum/excel-questions/813605-help-code-please.html#post3974639

Regards

 

[L. Howard]

Try this at the same place in the code. It adds the blue lines each time the code is run along with centering the value in the cells.
It re-formats the cells from the unwanted format that is copied to the sheet from the other sheet.

    With Range("F6,F10,F12,J10,J12,N10")
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .Cells.BorderAround _
       ColorIndex:=5, Weight:=xlThin
       
   End With
   With Range("F8:N8")
       .HorizontalAlignment = xlCenterAcrossSelection
       .Cells.BorderAround _
       ColorIndex:=5, Weight:=xlThin
   End With

I looked at your code in the other thread, but I cannot read the messages on the message box pop ups, or the Input boxes.
So it is difficult to know what you want the code to do to respond to the message on a message box or an Input box.

Howard

 

[_Fly_]

Howard please see that version https://drive.google.com/file/d/0B1U...ew?usp=sharing
Try the Procurar button. The function that appears this

MsgBox "Não foi encontrado nenhum artigo com esse código!" & vbCrLf & _
"Por favor, tente novamente.", vbExclamation, "Retirar Material"
GoTo myIB

Doesn't work anymore so if i put a code that doesn't exists at the database there is no warning msgbox anymore.

 

[L. Howard]

The link you posted is not valid, unable to download workbook.

Howard

 

[_Fly_]

Howard thanks but i think i have solved the question see my code:

Private Sub botão_procurar_Click()
Dim LRow As Long
Dim aRng As Range, rngFnd As Range
Dim myFnd As String
Dim myPut As String
Dim myPut2 As String

myIB:
myFnd = InputBox("Por favor, introduza o código do artigo que deseja retirar.", "Retirar Material")


If myFnd = "" Then
Exit Sub
ElseIf IsNumeric(myFnd) Then
myFnd = Val(myFnd) '/ converts a "text" number to a value
End If

With Sheets("Registos Globais")
LRow = Sheets("Registos Globais").Cells(Rows.Count, "A").End(xlUp).Row

Set rngFnd = Sheets("Registos Globais").Range("A2:A" & LRow).Find(What:=myFnd, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)

If Not rngFnd Is Nothing Then
rngFnd.Copy Sheets("Saídas").Range("F6")
rngFnd.Offset(, 2).Copy Sheets("Saídas").Range("F8")
rngFnd.Offset(, 7).Copy Sheets("Saídas").Range("f12")
rngFnd.Offset(, 6).Copy Sheets("Saídas").Range("J10")
Sheets("Saídas").Range("F10").Select

myIB2:
myPut = InputBox("O Stock actual de " & Range("F8") & " é de " & rngFnd.Offset(, 6) & " unidade(s)." & vbCrLf & "Qual a quantidade que deseja retirar?", "Retirar Material")
Range("F10").Value = myPut

If Sheets("Saídas").Range("F10") > rngFnd.Offset(, 6) Then
myPut2 = MsgBox("O Stock actual de " & Range("F8") & " é de " & rngFnd.Offset(, 6) & " unidade(s)." & vbCrLf & "No entanto você deseja retirar " & Sheets("Saídas").Range("F10") & " unidade(s)." & vbCr & "Por favor introduza um valor igual ou inferior a " & rngFnd.Offset(, 6) & " unidade(s).", vbExclamation, "Retirar Material")
GoTo myIB2
End If
If myPut = "" Then
Sheets("Saídas").Select
Range("f6:g6").ClearContents
Range("f8:n8").ClearContents
Range("j10").ClearContents
Range("f12").ClearContents
Range("f10").ClearContents
Exit Sub

End If

Else
MsgBox "Não foi encontrado nenhum artigo com esse código!" & vbCrLf & _
"Por favor, tente novamente.", vbExclamation, "Retirar Material"
GoTo myIB

End If
End With
End Sub

 

[L. Howard]

Hi Fly,

Is there someone who can translate the wording to English in all you InputBoxes and message boxes for you?

I think I could help better if I knew what they said so I would know how to adjust the code to make it work for you.

As it is, I don't know the conditions the message boxes or the Input boxes are working under.

Once the code works in the proper sequences, then you can translate back to Spanish. (I think that is your language??)

Howard

 

[L. Howard]

I ran you new code and seems to work fine. I added some code to try to fix the formatting problem you were having.

Try this code to see if it cures the formatting problem. Centers the values in the cells and puts the blue boxes around the cells.

When you copy the info from the other sheet, it brings the cell format with it and this code below restores the format as you want it.

Howard

This is your code with my formatting code added.

Private Sub botão_procurar_Click()
 Dim LRow As Long
 Dim aRng As Range, rngFnd As Range
 Dim myFnd As String
 Dim myPut As String
 Dim myPut2 As String

myIB:
 myFnd = InputBox("Por favor, introduza o código do artigo que deseja retirar.", "Retirar Material")


 If myFnd = "" Then
 Exit Sub
 ElseIf IsNumeric(myFnd) Then
 myFnd = Val(myFnd) '/ converts a "text" number to a value
 End If

 With Sheets("Registos Globais")
 LRow = Sheets("Registos Globais").Cells(Rows.Count, "A").End(xlUp).Row

 Set rngFnd = Sheets("Registos Globais").Range("A2:A" & LRow).Find(What:=myFnd, _
 LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
 SearchDirection:=xlNext, MatchCase:=False)

 If Not rngFnd Is Nothing Then
 rngFnd.Copy Sheets("Saídas").Range("F6")
 rngFnd.Offset(, 2).Copy Sheets("Saídas").Range("F8")
 rngFnd.Offset(, 7).Copy Sheets("Saídas").Range("f12")
 rngFnd.Offset(, 6).Copy Sheets("Saídas").Range("J10")
 Sheets("Saídas").Range("F10").Select
 
     With Range("F6,F10,F12,J10,J12,N10")
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .Cells.BorderAround _
       ColorIndex:=5, Weight:=xlThin
       
   End With
   With Range("F8:N8")
       .HorizontalAlignment = xlCenterAcrossSelection
       .Cells.BorderAround _
       ColorIndex:=5, Weight:=xlThin
   End With
 

myIB2:
 myPut = InputBox("O Stock actual de " & Range("F8") & " é de " & rngFnd.Offset(, 6) & " unidade(s)." & vbCrLf & "Qual a quantidade que deseja retirar?", "Retirar Material")
 Range("F10").Value = myPut

 If Sheets("Saídas").Range("F10") > rngFnd.Offset(, 6) Then
 myPut2 = MsgBox("O Stock actual de " & Range("F8") & " é de " & rngFnd.Offset(, 6) & " unidade(s)." & vbCrLf & "No entanto você deseja retirar " & Sheets("Saídas").Range("F10") & " unidade(s)." & vbCr & "Por favor introduza um valor igual ou inferior a " & rngFnd.Offset(, 6) & " unidade(s).", vbExclamation, "Retirar Material")
 GoTo myIB2
 End If
 
 If myPut = "" Then
   Sheets("Saídas").Range("f6:g6,f8:n8,j10,f12,f10").ClearContents
 Exit Sub

 End If

 Else
 MsgBox "Não foi encontrado nenhum artigo com esse código!" & vbCrLf & _
 "Por favor, tente novamente.", vbExclamation, "Retirar Material"
 GoTo myIB

 End If
 End With
 End Sub