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
A little higher upp, i wrote this:


NetZorro said:
It works like This.
In Sheet 1 > EAN_Inlasning Here i have a barcodescanner, (an inputvalue)
In Sheet 2 > LevListor Here are my resellers EAN-code lists
In Sheet 3 > LagerLista This is were my "inventory-list" is being made.

So, If scan a Bar-code ex: 5566778899123 , i have today the 1 Macro (ctrl+r) to search Sheet 3 (LagerLista) to look, if i already have enterd the value once. If i have, i atomaticly adds a value i have presetted in Sheet 1 to be added to the match in Sheet 3.

If ther is no match using Macro 1, i before got en error message.

Then i used the 2 macro, to make the exact same search, but this time in Sheet 2 (LevListor) and if the EAN is a match in that list (withc it properbly is) it copy the hole row in Sheet 2 (were the match was) to Sheet 3 (my Inventory list.

If its still not a match in Sheet 2 (an error used to came up) and then i hade the 3 macro, to copy the EAN, straight to Sheet 3 (my inventory list)

As anyone of you understand, this feels like a real waste of time, and should be able to do more smoothe.

Like, if match in Macro 1, dont start Macro 2, and 3, if there is not an match in Macro 1, start Macro 2, (and skip Macro 3) and if there is not an match in macro 2, start macro 3.
Click to expand...
Click to expand...

I Think thats what you mean, with what i whant, and how i do it today.

If this still do not answare you question, let me know.

Thanks for carring!
/NetZorro
(btw. sorry for the bad English)
 
Upvote 0

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
it says before you got an error...what are you getting now?

did you modify the code like i showed a couple posts ago? if so then maybe repost all three macros again so i can see if they look the way i intended...
 
Upvote 0
Here comes the 3 macros again, with your changes.

It ok, i don't get the error message any more

However there are some problem with them:
1. If the EAN-code dosent exist in sheet "LagerLista" it is being copyed from sheet "LevListor" (whitch is good)
but it also exekutes the last script, (like there were no match in "LevListor", but there were, so thats fault.

2. If i have a EAN-match in the first script (meaning the same value in "LagerLista") it still after adding an countnummber to the EAN (thats what the first script does) it stills executes both Macro 2 and macro 3, making the EAN appera again, in "LagerLista".

thats the problem now.. that even if the commanline "On Error GoTo xxx" should be used only if there is a problem, it doesent.. it still go over to the next macro, even if no problem occurd.

Anyway.. here comes the 3 macros:

Macro 1 (The one that should search sheet "LagerLista" to se if its a match, and if it is, it only adds an counter-number)

Code: 
Sub Search_and_Add_To_LagerLista_()
On Error GoTo SecondMacro
'
' 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
 'START
    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.End(xlToRight).Select 'Förflyttas längst till höger
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
        False, Transpose:=False 'Värdet ifrån B4 adderas med det antalet längst till höger
    '****
   End With
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!
SecondMacro:
CopyEAN_SearchLevListor_PasteLagerLista
End Sub

Macro 2 (The one that should search the sheet "LevListor" after o match, and if it is a match, copy the hole row, to a new row, into sheet "LagerLista"

Code: 
Sub CopyEAN_SearchLevListor_PasteLagerLista()
On Error GoTo ThirdMacro
'
' CopyEAN_SearchLevListor_PasteLagerLista Maro
' Makrot inspelat 2005-04-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!
ThirdMacro:
CopyNewToEAN_LagerLista
End Sub

Macro 3 (That i run, if there is no match after the sheets "LagerLista" and "LevListor" been searched. This macro just simply copy the EAN in the sheet called "EAN_Inlasning" to a new row in "LagerLista"

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

Hope this is to any help...
Please don't give up!! :oops:
/NetZorro
 
Upvote 0
I seem to see what your trying to do. I really would like to see your Excel workbook though, to see how it's layed out.

Remove any sensitive info, and use the blue email button at the bottom of my post and send it over to me via email. I can take a look at it better in this manner.
 
Upvote 0
Seems to work here:

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 = 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)
        
        Else
            
            With Blad4.Range("A1")
                .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
            
        End If
                
    End If
    
    Set r = Nothing
    Set rr = Nothing
End Sub
 
Upvote 0
Thanks...but
.. Hmm.. when i use this.. the "number" > Antal doesnt adds upp, it just "overwrite" the new value in "lagerlista".

Ex: xxxx 3

If i add one more off the same the new value is then changed from 3 to 1 instead of 3+1 = 4.

Also.. if an EAN doesent exist... it doesent add a new line.. nothing happens.

Should i remove the lines "On error go to" now also=?
 
Upvote 0
Okay, try this revision:

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)
        
        Else
            
            With Blad4.Range("A1")
                .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
            
        End If
                
    End If
    
    Set r = Nothing
    Set rr = Nothing
End Sub

Not sure what is happening to cause a new line not to be added, just leave the code as is for now, NO On Error statments as of yet, I would like to see what errors are encountered before adding it.
 
Upvote 0
Near....

A few "Buggs"

* When an EAN, that has not been added before, to LagerLista, it should have the value in sheet EAN_Inlasning B4. (no nothing writes out)

...but it works the "second" time you add the same EAN, no it ADDS.

* When no matches is being found... and it should copy a new row.. it doesent do this on a new row.. it does it att the first row in sheet LagerLista. (Thats a problem.. ) because next time something, that is not an match in EAN.. it overvwrites....

Is it something you can do about... :-D
 
Upvote 0
Try this:

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
            
        End If
                
    End If
    
    Set r = Nothing
    Set rr = Nothing
End Sub
 
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,941
Messages
6,175,537
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