VBA Vlookup, add +1 in value, Cut (ctrl+x), Paste

S

sorendk

New Member
Joined
Jul 10, 2018
Messages
3
Hi All

I have created an access control sheet.
I have 3 sheets
Sheet 1 name is "Start"
Sheet 2 name is "Hvad skal tjekkes" ---> translated, what shall be controlled
Sheet 3 name is "Arkiv" ----> translated, Archive

I have a push button in sheet "Start". This are running 10 different vba codes depending on status.

What do I want:

If value R2 is less then S2 (R2<S2) in sheet "Start" then (this will be run for makro1-makro9):

When button is pushed it shall do a Vlookup (if this is the right way to do it):
The number to lookup is in B4 sheet "Start".
The matrix where to find the number is from A2 to Z3000 in sheet "Hvad skal tjekkes".
When number has been lookedup it shall add +1 to the value in colum X.
So if the number is found in row 15, then it shall add value +1 in X15, if the number is found in row 9, then it shall add value +1 to X9 and so on.
Downunder you can see the start of my code and makro 1 (PLESE SEE my next question under the code):

Code: 
Private Sub CommandButton1_Click()

Dim shtInput As Worksheet
Dim shtOutput As Worksheet
Dim intSidsteraekke As Integer
Dim intInputraekke As Integer


If Range("B17").Value = 1 Then Makro = 1
If Range("B17").Value = 2 And Range("B17").Value < Range("B16").Value Then Makro = 2
If Range("B17").Value = 3 And Range("B17").Value < Range("B16").Value Then Makro = 3
If Range("B17").Value = 4 And Range("B17").Value < Range("B16").Value Then Makro = 4
If Range("B17").Value = 5 And Range("B17").Value < Range("B16").Value Then Makro = 5
If Range("B17").Value = 6 And Range("B17").Value < Range("B16").Value Then Makro = 6
If Range("B17").Value = 7 And Range("B17").Value < Range("B16").Value Then Makro = 7
If Range("B17").Value = 8 And Range("B17").Value < Range("B16").Value Then Makro = 8
If Range("B17").Value = 9 And Range("B17").Value < Range("B16").Value Then Makro = 9
If Range("B17").Value = Range("B16").Value Then Makro = 10

Antal = Makro

    Select Case Makro
        Case Is = 1
            Call Makro_1
            Range("B17").Value = Range("B17").Value + 1
        Case Is = 2
            Call Makro_2
            Range("B17").Value = Range("B17").Value + 1
        Case Is = 3
            Call Makro_3
            Range("B17").Value = Range("B17").Value + 1
        Case Is = 4
            Call Makro_4
            Range("B17").Value = Range("B17").Value + 1
        Case Is = 5
            Call Makro_5
            Range("B17").Value = Range("B17").Value + 1
        Case Is = 6
            Call Makro_6
            Range("B17").Value = Range("B17").Value + 1
        Case Is = 7
            Call Makro_7
            Range("B17").Value = Range("B17").Value + 1
        Case Is = 8
            Call Makro_8
            Range("B17").Value = Range("B17").Value + 1
        Case Is = 9
            Call Makro_9
            Range("B17").Value = Range("B17").Value + 1
        Case Is = 10
            Range("B17").Value = 1
            Call Makro_10
    End Select
End Sub

Sub Makro_1()
'find sidste række med data så der kopieres ind i næste række
intSidsteraekke = Sheets("Rapportering").Cells(Sheets("Rapportering").Rows.Count, "A").End(xlUp).Row
intInputraekke = intSidsteraekke + 1

Sheets("Rapportering").Cells(intInputraekke, 1) = Sheets("Start").Range("B2").Value
Sheets("Rapportering").Cells(intInputraekke, 2) = Sheets("Start").Range("B4").Value
Sheets("Rapportering").Cells(intInputraekke, 3) = Sheets("Start").Range("B6").Value
Sheets("Rapportering").Cells(intInputraekke, 4) = Sheets("Start").Range("B8").Value
Sheets("Rapportering").Cells(intInputraekke, 5) = Sheets("Start").Range("Q15").Value
Sheets("Rapportering").Cells(intInputraekke, 6) = Sheets("Start").Range("B11").Value
Sheets("Rapportering").Cells(intInputraekke, 7) = Sheets("Start").Range("B12").Value
Sheets("Rapportering").Cells(intInputraekke, 8) = Sheets("Start").Range("B20").Value
Sheets("Rapportering").Cells(intInputraekke, 9) = Sheets("Start").Range("B21").Value
Sheets("Rapportering").Cells(intInputraekke, 10) = Sheets("Start").Range("B22").Value
Sheets("Rapportering").Cells(intInputraekke, 11) = Sheets("Start").Range("B23").Value
Sheets("Rapportering").Cells(intInputraekke, 12) = Sheets("Start").Range("B24").Value
Sheets("Rapportering").Cells(intInputraekke, 13) = Sheets("Start").Range("B25").Value
Sheets("Rapportering").Cells(intInputraekke, 90) = Sheets("Start").Range("V20").Value
Sheets("Rapportering").Cells(intInputraekke, 91) = Sheets("Start").Range("V21").Value
Sheets("Rapportering").Cells(intInputraekke, 92) = Sheets("Start").Range("V22").Value
Sheets("Rapportering").Cells(intInputraekke, 93) = Sheets("Start").Range("V23").Value
Sheets("Rapportering").Cells(intInputraekke, 94) = Sheets("Start").Range("V24").Value
Sheets("Rapportering").Cells(intInputraekke, 95) = Sheets("Start").Range("V25").Value
Sheets("Rapportering").Cells(intInputraekke, 14) = Sheets("Start").Range("A28").Value
    Range("B20").Select
    Selection.ClearContents
    Range("B21").Select
    Selection.ClearContents
    Range("B22").Select
    Selection.ClearContents
    Range("B23").Select
    Selection.ClearContents
    Range("B24").Select
    Selection.ClearContents
    Range("B25").Select
    Selection.ClearContents
    Range("A28:D34").Select
    Selection.ClearContents

End Sub
Next question:
If R2 is equal to S2 (R2=S2) in sheet "Start" then do Vlookup:

Vlookup
The number to lookup is in B4 sheet "Start".
The matrix where to find the number is from A2 to Z3000 in sheet "Hvad skal tjekkes".
I would like this row to get Cut (ctrl+x) A:Z and put into the next empty row in sheet "Arkiv".
code for makro10:

Code: 
Sub Makro_10()

'find sidste række med data så der kopieres ind i næste række
intSidsteraekke = Sheets("Rapportering").Cells(Sheets("Rapportering").Rows.Count, "A").End(xlUp).Row
intInputraekke = intSidsteraekke

' kopier fra input til output
Sheets("Rapportering").Cells(intInputraekke, 71) = Sheets("Start").Range("B20").Value
Sheets("Rapportering").Cells(intInputraekke, 72) = Sheets("Start").Range("B21").Value
Sheets("Rapportering").Cells(intInputraekke, 73) = Sheets("Start").Range("B22").Value
Sheets("Rapportering").Cells(intInputraekke, 74) = Sheets("Start").Range("B23").Value
Sheets("Rapportering").Cells(intInputraekke, 75) = Sheets("Start").Range("B24").Value
Sheets("Rapportering").Cells(intInputraekke, 76) = Sheets("Start").Range("B25").Value
Sheets("Rapportering").Cells(intInputraekke, 77) = Sheets("Start").Range("A28").Value
Sheets("Rapportering").Cells(intInputraekke, 144) = Sheets("Start").Range("V20").Value
Sheets("Rapportering").Cells(intInputraekke, 145) = Sheets("Start").Range("V21").Value
Sheets("Rapportering").Cells(intInputraekke, 146) = Sheets("Start").Range("V22").Value
Sheets("Rapportering").Cells(intInputraekke, 147) = Sheets("Start").Range("V23").Value
Sheets("Rapportering").Cells(intInputraekke, 148) = Sheets("Start").Range("V24").Value
Sheets("Rapportering").Cells(intInputraekke, 149) = Sheets("Start").Range("V25").Value
Range("B2") = Range("B2") + 1
    Range("B4").Select
    Selection.ClearContents
    Range("B6").Select
    Selection.ClearContents
    Range("B8").Select
    Selection.ClearContents
    Range("B9").Select
    Selection.ClearContents
    Range("B11").Select
    Selection.ClearContents
    Range("B12").Select
    Range("B17").Value = 1
    Selection.ClearContents
    Range("B20").Select
    Selection.ClearContents
    Range("B21").Select
    Selection.ClearContents
    Range("B22").Select
    Selection.ClearContents
    Range("B23").Select
    Selection.ClearContents
    Range("B24").Select
    Selection.ClearContents
    Range("B25").Select
    Selection.ClearContents
    Range("A28:D34").Select
    Selection.ClearContents
ThisWorkbook.Close savechanges:=True


End Sub
WOW I hope someone can help me complete my worksheet.

Best regard
Soren
 
Last edited by a moderator:

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Sort by date Sort by votes
Welcome to the forum.

Please take a minute to read the forum rules, especially the one about cross-posting, and comply with them. Thanks. :)
 
Upvote 0
Hi RoryA

Thanks for letting me know.
I have now linked and made a note that this is a cross-posting, and why I have done it.
 
Upvote 0
You need to add links here please.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
VBA code to cut and paste multiple filtered rows based on multiple criteria
Replies
2
Views
442
Alex Blakenburg
A
gtd526
  • Solved
vba selecting entire range from offset
Replies
5
Views
163
Tetra201
Tetra201
esset
  • Solved
Splitting hours worked into multiple shift patterns
Replies
3
Views
542
esset
esset
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
335
Agnarr
Agnarr
M
  • Solved
PDF creation of different sheet based on column value.
Replies
2
Views
257
mummbles74
M

Forum statistics

Threads
1,214,525
Messages
6,120,051
Members
448,940
Latest member
mdusw

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