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

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

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
39,057
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
Welcome to the forum.

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

sorendk

New Member
Joined
Jul 10, 2018
Messages
3
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.
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
39,057
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
You need to add links here please.
 

Forum statistics

Threads
1,171,630
Messages
5,876,544
Members
433,199
Latest member
guerin47

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
Top