Combining 2 macros into 1

kayoke

New Member
Joined
Jun 28, 2012
Messages
7
Hello,

I've 2 macros, "FirstUpdat" and "Update" for updating training data into my database.

The "FirstUpdate" searches for the employee's name (Update sheet) in Database sheet and copy & paste training data into the adj cells of the searched name.

The "Update" searches for the employee's name (Update sheet) in Database sheet, insert 1 row below the searched employee's name, copy down all the employee's background data (e.g. department, designation, employee code ...), then copy & paste the training data into the adj cells of the copied down data.

As you can see, both of the macro functions for 2 different conditions,
1. When employee doesn't have existing training data at all;
2. When employee has existing training data.

I think that this method is quite tedious as I've to know which employee doesn't have any existing training data and which employee already has existing training data. Therefore, I'm wondering if I could have a way to combine both of these macros so that I'll only have 1 macro that functions like:
1. If the employee doesn't have existing training data, insert the new training data into the same row as current employee name;
2. If the employee has existing training data, insert the new training data into a row below the existing employee name and copy down all the employee's background data (this is because the "SearchEngine" macro will need all these data to be present before I can use them for query)

I've tried asking this question in my previous posts but there isn't any reply so I guess either it couldn't be done or people aren't clear with what I wanted. Therefore, I've separated the intended macro into 2 and hoping that there will be answers this time round. Please advise. Thanks.

Anyway, I've cross-posted the file onto http://www.excelforum.com/excel-pro...ing-2-different-macro-into-1-a.html?p=2844803 because I can't upload a file here.

kayoke
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Code:
Sub FirstUpdate()
'
' SaveUpdate Macro
'
Application.ScreenUpdating = False
Sheets("Update").Select
    If Range("D8") = "1" Then
       
    Dim Error As Integer
    Error = MsgBox("Please enter data for updating.", vbOKOnly, "Error")
    
    Else
    Dim ws1 As Worksheet, ws2 As Worksheet, fAddress$
    Dim FoundOne As Range, LookInR As Range, LookForR As Range, c As Range
    Application.ScreenUpdating = False
    Set ws1 = Sheets("Database")
    Set ws2 = Sheets("Update")
    Set LookInR = Range(ws1.Range("A1"), ws1.Range("A" & Columns.Count).End(xlUp))
    Set LookForR = Range(ws2.Range("F9"), ws2.Range("F" & Rows.Count).End(xlUp))
    For Each c In LookForR
        With LookInR
            Set FoundOne = .Find(What:=c, LookAt:=xlPart)
            If Not FoundOne Is Nothing Then
            Do
             fAddress = FoundOne.Address
             FoundOne.Offset(, 7).Value = c.Offset(, 1).Value
             FoundOne.Offset(, 8).Value = c.Offset(, 2).Value
             FoundOne.Offset(, 9).Value = c.Offset(, 3).Value
             FoundOne.Offset(, 10).Value = c.Offset(, 4).Value
             FoundOne.Offset(, 11).Value = c.Offset(, 5).Value
             FoundOne.Offset(, 12).Value = c.Offset(, 6).Value
             FoundOne.Offset(, 13).Value = c.Offset(, 7).Value
             FoundOne.Offset(, 14).Value = c.Offset(, 8).Value
             FoundOne.Offset(, 15).Value = c.Offset(, 9).Value
             FoundOne.Offset(, 16).Value = c.Offset(, 10).Value
             FoundOne.Offset(, 17).Value = c.Offset(, 11).Value
             FoundOne.Offset(, 18).Value = c.Offset(, 12).Value
             Set FoundOne = .FindNext(After:=FoundOne)
             Loop While FoundOne.Address <> fAddress
        End If
        End With
    Next c
    Set ws1 = Nothing
    Set ws2 = Nothing
    Set LookInR = Nothing: Set LookForR = Nothing
    Application.ScreenUpdating = False
    
    Sheets("Update").Select
    Range("D8").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D10").Select
    Selection.ClearContents
    Range("D12").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D14").Select
    Selection.ClearContents
    Range("D16").Select
    Selection.ClearContents
    Range("D18").Select
    Selection.ClearContents
    Range("D20").Select
    Selection.ClearContents
    Range("D22").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D24").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D26").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D28").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D30").Select
    Selection.ClearContents
    Range("D32").Select
    Selection.ClearContents
    Range("D8").Select
    
    Dim Response As Integer
    Response = MsgBox("Your entry has been recorded in the database. Would you like to view it?", vbYesNo + vbInformation, "Input Feedback")
    If Response = vbYes Then
    Sheets("Database").Select
    Else
    Sheets("Update").Select
    Range("D8").Select
    
End If
End If
End Sub
[\Code]

and 

[Code]
Sub Update()
Application.ScreenUpdating = False
Sheets("Update").Select
    If Range("D8") = "1" Then
       
    Dim Error As Integer
    Error = MsgBox("Please enter data for updating.", vbOKOnly, "Error")
    
    Else
  Dim DataSH As Worksheet
  Set DataSH = Sheets("Database")
  Set findit = DataSH.Cells.Find(What:=Range("F9"), After:=DataSH.Range("A1"), SearchDirection:=xlPrevious)
  DataSH.Activate
findit.Select
'Insert row below active cell
ActiveCell.Offset(1).EntireRow.Insert
Sheets("Update").Select
    Range("G9:R9").Select
    Selection.Copy
Sheets("Database").Select
ActiveCell.Offset(1, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
Sheets("Update").Select
  Set findit = DataSH.Cells.Find(What:=Range("F9"), After:=DataSH.Range("A1"), SearchDirection:=xlPrevious)
  DataSH.Activate
findit.Select
ActiveCell.Offset(0, 6).Range("A1").Select
Range(Selection, Selection.End(xlToLeft)).Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:G2"), Type:= _
        xlFillDefault
Sheets("Database").Select
Dim Lst As Long
Dim Rng As Range
Dim Rw As Long
Lst = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    For Rw = Lst To 2 Step -1
        With Range("A" & Rw)
            If Application.CountIf(Rng, .Value) > 1 Then
                .Font.ColorIndex = 2
            End If
        End With
            Set Rng = Range("A1 :A" & Lst).Resize(Rw - 1)
    Next Rw
Dim c As Range
For Each c In Columns(1).SpecialCells(xlCellTypeConstants, 23)
  c.Offset(, 1).Resize(, 7).Font.ColorIndex = c.Font.ColorIndex
    Next
    
Dim LastRow As Long
With Worksheets("PreSearch")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A3:AC3").AutoFill Destination:=.Range("A3:AC" & LastRow) _
, Type:=xlFillDefault
Range("A1").Select
With Worksheets("MidSearch")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A3:S3").AutoFill Destination:=.Range("A3:S" & LastRow) _
, Type:=xlFillDefault
Range("A1").Select
With Worksheets("PostSearch")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A3:S3").AutoFill Destination:=.Range("A3:S" & LastRow) _
, Type:=xlFillDefault
Range("A1").Select
    
Sheets("Update").Select
    Range("D8").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D10").Select
    Selection.ClearContents
    Range("D12").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D14").Select
    Selection.ClearContents
    Range("D16").Select
    Selection.ClearContents
    Range("D18").Select
    Selection.ClearContents
    Range("D20").Select
    Selection.ClearContents
    Range("D22").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D24").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D26").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D28").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D30").Select
    Selection.ClearContents
    Range("D32").Select
    Selection.ClearContents
    
    Dim Response As Integer
    Response = MsgBox("Your entry has been recorded in the database. Would you like to view it?", vbYesNo + vbInformation, "Input Feedback")
    If Response = vbYes Then
    Sheets("Database").Select
    Else
    Sheets("Update").Select
    Range("D8").Select
End If
End With
End With
End With
End If
End Sub
[\Code]
 
Upvote 0
Try (untested):

Code:
Sub UpdateAll()
'
'   UpdateAll Macro
'
    Application.ScreenUpdating = False
    Sheets("Update").Select
    If Range("D8") = "1" Then
        Dim Error As Integer
        Error = MsgBox("Please enter data for updating.", vbOKOnly, "Error")
    Else
        Dim ws1 As Worksheet, ws2 As Worksheet, fAddress$
        Dim FoundOne As Range, LookInR As Range, LookForR As Range, c As Range
        Set ws1 = Sheets("Database")
        Set ws2 = Sheets("Update")
        Set LookInR = Range(ws1.Range("A1"), ws1.Range("A" & Columns.Count).End(xlUp))
        Set LookForR = Range(ws2.Range("F9"), ws2.Range("F" & Rows.Count).End(xlUp))
        For Each c In LookForR
            With LookInR
                Set FoundOne = .Find(What:=c, LookAt:=xlPart)
                If Not FoundOne Is Nothing Then
                    Do
                        fAddress = FoundOne.Address
                        FoundOne.Offset(, 7).Value = c.Offset(, 1).Value
                        FoundOne.Offset(, 8).Value = c.Offset(, 2).Value
                        FoundOne.Offset(, 9).Value = c.Offset(, 3).Value
                        FoundOne.Offset(, 10).Value = c.Offset(, 4).Value
                        FoundOne.Offset(, 11).Value = c.Offset(, 5).Value
                        FoundOne.Offset(, 12).Value = c.Offset(, 6).Value
                        FoundOne.Offset(, 13).Value = c.Offset(, 7).Value
                        FoundOne.Offset(, 14).Value = c.Offset(, 8).Value
                        FoundOne.Offset(, 15).Value = c.Offset(, 9).Value
                        FoundOne.Offset(, 16).Value = c.Offset(, 10).Value
                        FoundOne.Offset(, 17).Value = c.Offset(, 11).Value
                        FoundOne.Offset(, 18).Value = c.Offset(, 12).Value
                        Set FoundOne = .FindNext(After:=FoundOne)
                    Loop While FoundOne.Address <> fAddress
                End If
            End With
        Next c
        Set ws1 = Nothing
        Set ws2 = Nothing
        Set LookInR = Nothing: Set LookForR = Nothing
        Dim DataSH As Worksheet
        Dim findit As Range
        Set DataSH = Sheets("Database")
        Set findit = DataSH.Cells.Find(What:=Range("F9"), After:=DataSH.Range("A1"), SearchDirection:=xlPrevious)
        DataSH.Activate
        findit.Select
'       Insert row below active cell
        ActiveCell.Offset(1).EntireRow.Insert
        Sheets("Update").Select
        Range("G9:R9").Select
        Selection.Copy
        Sheets("Database").Select
        ActiveCell.Offset(1, 7).Range("A1").Select
        Selection.PasteSpecial Paste:=xlValues, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Sheets("Update").Select
        Set findit = DataSH.Cells.Find(What:=Range("F9"), After:=DataSH.Range("A1"), SearchDirection:=xlPrevious)
        DataSH.Activate
        findit.Select
        ActiveCell.Offset(0, 6).Range("A1").Select
        Range(Selection, Selection.End(xlToLeft)).Select
        Selection.AutoFill Destination:=ActiveCell.Range("A1:G2"), Type:= _
            xlFillDefault
        Sheets("Database").Select
        Dim Lst As Long
        Dim Rng As Range
        Dim Rw As Long
        Lst = Range("A" & Rows.Count).End(xlUp).Row
        Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
        For Rw = Lst To 2 Step -1
            With Range("A" & Rw)
                If Application.CountIf(Rng, .Value) > 1 Then
                    .Font.ColorIndex = 2
                End If
            End With
            Set Rng = Range("A1 :A" & Lst).Resize(Rw - 1)
        Next Rw
        For Each c In Columns(1).SpecialCells(xlCellTypeConstants, 23)
            c.Offset(, 1).Resize(, 7).Font.ColorIndex = c.Font.ColorIndex
        Next
        Dim LastRow As Long
        With Worksheets("PreSearch")
            LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
            .Range("A3:AC3").AutoFill Destination:=.Range("A3:AC" & LastRow) _
                , Type:=xlFillDefault
        End With
        With Worksheets("MidSearch")
            LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
            .Range("A3:S3").AutoFill Destination:=.Range("A3:S" & LastRow) _
                , Type:=xlFillDefault
        End With
        With Worksheets("PostSearch")
            LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
            .Range("A3:S3").AutoFill Destination:=.Range("A3:S" & LastRow) _
                , Type:=xlFillDefault
        End With
        Sheets("Update").Select
        Range("D8").FormulaR1C1 = "1"
        Range("D10").ClearContents
        Range("D12").FormulaR1C1 = "1"
        Range("D14").ClearContents
        Range("D16").ClearContents
        Range("D18").ClearContents
        Range("D20").ClearContents
        Range("D22").FormulaR1C1 = "1"
        Range("D24").FormulaR1C1 = "1"
        Range("D26").FormulaR1C1 = "1"
        Range("D28").FormulaR1C1 = "1"
        Range("D30").ClearContents
        Range("D32").ClearContents
        Dim Response As VbMsgBoxResult
        Response = MsgBox("Your entry has been recorded in the database. Would you like to view it?", vbYesNo + vbInformation, "Input Feedback")
        If Response = vbYes Then
            Sheets("Database").Select
        Else
            Sheets("Update").Select
            Range("D8").Select
        End If
    End If
End Sub
 
Upvote 0
Nope. The suggested macro doesn't work. For employees without existing data, it updates 2 sets of new training data instead of 1. For employees with existing data, it loops forever and I've to force close the worksheet.
 
Upvote 0
I don't know why it wouldn't work because I merely combined the code. If you want to run the macros one after the other you can try:

Code:
Sub UpdateAll()
    Call FirstUpdate
    Call Update
End Sub
 
Upvote 0
I don't really want to run both macros 1 after another. Everytime I do an update, each employee would have only attended 1 workshop (assuming that I'm always prompt in my update). So under the target employee, I would only have 1 new workshop data each time I update. If I call upon 2 macros at 1 after another, it'll have the problems as suggested in the previous post. What I really want to achieve is something like this:

If:
Employee A ____________(no data)_______________________, the incoming workshop data will be filled under this _____ area.

If:
Employee A Workshop A Cost A Attended date A
Employee A ____________(no data)_______________________, the incoming workshop data will be filled under this ____ area.

The difference between the 2 "if" conditions is that 1 has existing workshop data but the other doesn't.
 
Upvote 0
You are assuming that I understand the layout of your data, which i don't. Can you explain your conditions in terms of VBA code?
 
Upvote 0
The reasons why I need explain in that manner is:
1. I don't speak VBA language
2. I've explained how both macros work in my very 1st post and I'm assuming that you don't understand that's why I explain again in an alternative way
3. This forum doesn't allow me to post any file and I've cross-posted it somewhere which I assume you haven't got the time to review

So as a conclusion, I thank you for your attempt to help and I think I can close this thread.
 
Upvote 0
I just want to say that the solution is not that hard I think. I saw your other post and I think you have accomplished so much kayoke. Sometimes is hard to understand the way others are talking to us or what they need to work with the code.

We are here to help each other. Btw way if you try another forum mention that you need and if statement to determine which macro to run.

peace
 
Upvote 0

Forum statistics

Threads
1,213,563
Messages
6,114,329
Members
448,564
Latest member
ED38

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