Macro 1, Macro 2, Macro 3 > after each other! Need HELP!

N

NetZorro

New Member
Joined
Aug 23, 2005
Messages
27
Would REALLY need som help.
Today i use 3 macro.
I want to combine them.. i have search and read the form for so long now, and cant find an answare. Please help me!! Need this badly!

Macro 1

Code: 
Sub Search_and_Add_To_LagerLista_()
'
' Makro1 Makro
' Söker o kopiera in värden efter EAN-coder som redan finns i bladet "LagerLista"
'
' Kortkommando: Ctrl+r
'
'Del1: Bla. så börja dem med att placera sig längst upp, i det övre fönstret, och markera även
'kolumn E.  Efter det så letar den efter ett värde från C4, i hela Kolumn E
   With Sheets("LagerLista")
    Sheets("LagerLista").Select
    ActiveWindow.Panes(1).Activate
    Columns("E:E").Select
   .Columns("E:E").Find( _
            What:=Sheets("EAN_Inlasning").Range("C4").Value, _
            After:=ActiveCell, _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False, _
            SearchFormat:=False).Select
  End With
  
  'START av addering utav Antal
    ActiveCell.Offset(0, 3).Range("A1").Select
    Sheets("EAN_Inlasning").Select 'Förflyttas till EAN_Inlasning
    Range("B4").Select 'B4 dvs. Antal markeras
    Application.CutCopyMode = False
    Selection.Copy 'B4 dvs. Antal kopieras
    Sheets("LagerLista").Select 'Förflyttas till LagerLista
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
        False, Transpose:=False 'Värdet ifrån B4 adderas med det antalet längst till höger
    '****
 
Sheets("LagerLista").Select   'LevListor markeras (kan ev. ta bort) och kolumn E Markeras (för säkerhets skull, behövdes innan jag lade variablen högre upp
Application.CutCopyMode = False
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Sheets("EAN_Inlasning").Select   'Bladet EAN_Inlasning markeras
Range("C4").Select  'Nu är allt klart, och markören står på C4, och redo för att ändras!
End Sub

Macro 2

Code: 
Sub CopyEAN_SearchLevListor_PasteLagerLista()

'
' CopyEAN_SearchLevListor_PasteLagerLista Maro
' Makrot inspelat 2005-08-14
'
' Kortkommando: Ctrl+q
'

'Nedre 4 rader bara ser till att markören står på rätt sätt i LagerLista-bladet, eftersom det är viktigt.
Sheets("LagerLista").Select   'Bladet LagerLista markeras
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select

'Går tillbaka till bladet EAN_Inlasning, där sökvärdet finns.
Sheets("EAN_Inlasning").Select
Range("C4").Select

'Del2: Bla. så börja dem med att placera sig längst upp, i det övre fönstret, och markera även
'kolumn E.  Efter det så letar den efter ett värde från C4, i hela Kolumn E
   With Sheets("LevListor")
    Sheets("LevListor").Select
    ActiveWindow.Panes(1).Activate
    Columns("E:E").Select
   .Columns("E:E").Find( _
            What:=Sheets("EAN_Inlasning").Range("C4").Value, _
            After:=ActiveCell, _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False, _
            SearchFormat:=False).Select
   End With
   
Selection.EntireRow.Select  'Här markeras den rad som hittar en "Match"
Selection.Copy  'Raden som var en "Match" kopieras
Sheets("LagerLista").Select     'Bladet LagerLista markeras
ActiveSheet.Paste      'Det som kopierades från Kolumn E, klistas in.
Selection.End(xlToRight).Select 'Markör flyttas så mycket det går till höger
ActiveCell.Offset(0, 1).Range("A1").Select 'Markör flyttas yttligare ett steg, Till Antal kolumnen
ActiveCell.FormulaR1C1 = "1" 'Antal får "grundvärdet" 1
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select   'Markören har nu flyttats ner så att nästa inklistring inte kommer ovanpå, utan under
Application.CutCopyMode = False
Sheets("EAN_Inlasning").Select   'Bladet EAN_Inlasning markeras
Range("C4").Select  'Nu är allt klart, och markören står på B2, och redo för att ändras!
    Sheets("EAN_Inlasning").Select
    Range("C4").Select
    Selection.Copy
    Sheets("LagerLista").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
        ActiveCell.FormulaR1C1 = "xxxx"
        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveCell.FormulaR1C1 = "xxxx"
        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveCell.FormulaR1C1 = "xxxx"
        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveSheet.Paste '**** av EAN-kopiering
        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveCell.FormulaR1C1 = "xxxx"
        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveCell.FormulaR1C1 = "xxxx"
        ActiveCell.Offset(0, 1).Range("A1").Select
        Sheets("EAN_Inlasning").Select
        Range("B4").Select
    Selection.Copy
    Sheets("LagerLista").Select
        ActiveSheet.Paste '**** av Antal-kopiering
    Range("A1").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(0, 1).Range("A1").Select
End Sub

Macro 2

Code: 
Sub CopyNewToEAN_LagerLista()
'
' CopyNewToEAN_LagerLista Makro
' Makrot inspelat 2005-08-25 av Daniel Persson
'
' Kortkommando: Ctrl+t
'
    Sheets("EAN_Inlasning").Select
    Range("C4").Select
    Selection.Copy
    Sheets("LagerLista").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
        ActiveCell.FormulaR1C1 = "xxxx"
        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveCell.FormulaR1C1 = "xxxx"
        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveCell.FormulaR1C1 = "xxxx"
        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveSheet.Paste '**** av EAN-kopiering
        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveCell.FormulaR1C1 = "xxxx"
        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveCell.FormulaR1C1 = "xxxx"
        ActiveCell.Offset(0, 1).Range("A1").Select
        Sheets("EAN_Inlasning").Select
        Range("B4").Select
    Selection.Copy
    Sheets("LagerLista").Select
        ActiveSheet.Paste '**** av Antal-kopiering
    Range("A1").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(0, 1).Range("A1").Select
End Sub

Pleeessse...... bare with me!
/NetZorro
 
Sort by date Sort by votes
Now it works Perfekt!... just a detail..
I would realy like the sheet "LagerLista" to be displated and the courser (where you start to write) on column "modell" when something "new" has been added...

(Because i manualy typ this in then... ) a little hard to know what it is.. by just looking att an EAN-number...

If thats possioble to.. that would be realy great...

When i have you on the line..
I also want an "button" to the right of the EAN, so you just press Enter, so starts the macro...... is that hard to do?

THANKS for everything..
I don't now how to pay you back.. (money maybe?)
Thanks anyway....
 
Upvote 0

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Code: 
Option Explicit

Sub YourCombinedMacro()
    Dim r As Range
    Dim rr As Range
    
    Dim szEAN As String
        szEAN = Blad1.Range("C4").Value
        
    Dim lAntel As Long
        lAntel = Blad1.Range("B4").Value
        
        
    Set r = Blad4.Columns("E:E").Find(szEAN, , xlValues, xlWhole)
    
    If Not r Is Nothing Then
    
        r.Offset(0, 3).Value = r.Offset(0, 3).Value + lAntel
        
    Else
    
        Set rr = Blad2.Columns("E:E").Find(szEAN, , xlValues, xlWhole)
        If Not rr Is Nothing Then
        
            rr.EntireRow.Copy Blad4.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            Blad4.Cells(Rows.Count, 1).End(xlUp).Offset(, 7).Value = lAntel
            
        Else
            
            With Blad4.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                .Value = "XXXX"
                .Offset(, 1).Value = "XXXX"
                .Offset(, 2).Value = "XXXX"
                .Offset(, 3).Value = "XXXX"
                .Offset(, 4).Value = szEAN
                .Offset(, 5).Value = "XXXX"
                .Offset(, 6).Value = "XXXX"
                .Offset(, 7).Value = lAntel
            End With
             Blad4.Select
             Cells(Rows.Count, 1).End(xlUp).Offset(, 1).Select
             
        End If
                
    End If
    
    Set r = Nothing
    Set rr = Nothing
    
End Sub

To grab a button: from Excel go to VIEW > TOOLBARS > FORMS and a toolbars will appear with buttons, etc.. for you to use. Select a button, put it on the sheet where you want it, Right click on the edge of it > Assign Macro > and assign to the code's name:

Hope it works well for you.
 
Upvote 0
True.. it was not that button i was thinking of...

I was thinking.. that now.. when i have scanned in an EAN.. it automaticaly moves one stepp to the right. (In this case to D4, in sheet EAN_Inlasning)
Is it possioble.. to have D4 *** an button.. and when that is marked.. and then pressed. enter (or automaticly) starts an macro.... thats what i was meaning.

/NetZorro
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question Question
Years together I was using a macro for automate a w/book is not as on today why?
Replies
1
Views
475
GlennUK
G
Z
  • Solved
Apply 1 macro to all sheets in a workbook: Why is this code not working?
Replies
2
Views
455
ZA_Fella
Z
J
  • Question Question
VBA - need assistance with macro regarding one value vs multiple
Replies
1
Views
566
rlv01
R
A
  • Solved
Sumif not working on my macros but working when i am pressing F8
Replies
3
Views
579
Zot
Z
C
  • Solved
Can someone help me insert a loop into this macro I created?
Replies
9
Views
659
Alex Blakenburg
A

Forum statistics

Threads
1,223,942
Messages
6,175,544
Members
452,652
Latest member
eduedu

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