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:

Some videos you may like

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
35,517
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
35,517
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
You need to add links here please.
 

Watch MrExcel Video

Forum statistics

Threads
1,109,336
Messages
5,528,105
Members
409,802
Latest member
joeino

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top