Merge 2 codes into 1

I

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,738
Office Version
  1. 2007
Platform
  1. Windows
Hi,
Can you please advise the way to merge the following codes.

Then i will have the 1 button the press to run both codes.

Many Thanks for all your help.

Code: 
Sub LEADERBOARD()    '' leaderboard Macro'    Range("C1:F17").Copy Range("I1")
    Worksheets("HONDA SHEET").Range("C1:D17").Copy Worksheets("SOLD ITEMS").Range("C2:D19")
    Worksheets("HONDA SHEET").Range("E1:F17").Copy Worksheets("SOLD ITEMS").Range("C19:D35")


    ActiveWorkbook.Worksheets("SOLD ITEMS").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("SOLD ITEMS").Sort.SortFields.Add Key:=Range("D2"), _
    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortTextAsNumbers
    With Worksheets("SOLD ITEMS").Sort
        .SetRange Range("C2:D35")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    With Worksheets("SOLD ITEMS").Range("C2:D35").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        End With
    Application.Goto Sheets("SOLD ITEMS").Range("A5")
    
    End Sub

Then code below added after the above code,

Code: 
Private Sub CommandButton1_Click()Dim myStr As String
Dim x As Integer
Dim myRange As Range


Set myRange = Sheets("SOLD ITEMS").Range("C2:D35")




myData = myRange.Value




For x = 1 To UBound(myData, 1)
    myStr = myStr & myData(x, 1) & vbTab & myData(x, 2) & vbCrLf
Next x




MsgBox myStr




End Sub
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
See the note in red font. The Range needs a qualifying sheet reference and I could not determine what it was from the original code.

Code: 
Private Sub CommandButton1_Click()Dim myStr As String
Dim x As Integer
Dim myRange As Range
Set myRange = Sheets("SOLD ITEMS").Range("C2:D35")
myData = myRange.Value
For x = 1 To UBound(myData, 1)
    myStr = myStr & myData(x, 1) & vbTab & myData(x, 2) & vbCrLf
Next x
MsgBox myStr
[COLOR=#FF0000](Insert Sheet Name Here[/COLOR]).Range("C1:F17").Copy Range("I1")
    Worksheets("HONDA SHEET").Range("C1:D17").Copy Worksheets("SOLD ITEMS").Range("C2:D19")
    Worksheets("HONDA SHEET").Range("E1:F17").Copy Worksheets("SOLD ITEMS").Range("C19:D35")
    ActiveWorkbook.Worksheets("SOLD ITEMS").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("SOLD ITEMS").Sort.SortFields.Add Key:=Range("D2"), _
    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortTextAsNumbers
    With Worksheets("SOLD ITEMS").Sort
        .SetRange Range("C2:D35")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With Worksheets("SOLD ITEMS").Range("C2:D35").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        End With
    Application.Goto Sheets("SOLD ITEMS").Range("A5")   
End Sub
 
Upvote 0
This is what i have done but it needs an edit please.

I click on a button which then runs this code.

Code: 
Sub LEADERBOARD()    '' leaderboard Macro'    Range("C1:F17").Copy Range("I1")
    Worksheets("HONDA SHEET").Range("C1:D17").Copy Worksheets("SOLD ITEMS").Range("C2:D19")
    Worksheets("HONDA SHEET").Range("E1:F17").Copy Worksheets("SOLD ITEMS").Range("C19:D35")


    ActiveWorkbook.Worksheets("SOLD ITEMS").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("SOLD ITEMS").Sort.SortFields.Add Key:=Range("D2"), _
    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortTextAsNumbers
    With Worksheets("SOLD ITEMS").Sort
        .SetRange Range("C2:D35")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    With Worksheets("SOLD ITEMS").Range("C2:D35").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        End With
    Application.Goto Sheets("SOLD ITEMS").Range("A5")
    Call Macro10
    End Sub

At the bottom of the code above it Calls Macro10

This is Macro10 below

Code: 
Sub Macro10()'
' Macro10 Macro
'


'
Dim myStr As String
Dim x As Integer
Dim myRange As Range


Set myRange = Sheets("SOLD ITEMS").Range("C2:D35")




myData = myRange.Value




For x = 1 To UBound(myData, 1)
    myStr = myStr & myData(x, 1) & vbTab & myData(x, 2) & vbCrLf
Next x




MsgBox myStr




End Sub

The final result is a message box look a like BUT its shown on the SOLD ITEMS sheet.
I would like it to be shown on the HONDA SHEET.

I changed the line Application.Goto Sheets("SOLD ITEMS").Range("A5") to Application.Goto Sheets("HONDA SHEETS").Range("A5") thinking it would be correct but its not 100% correct.

I do see the message box look alike which is good BUT i also see some kind of pasted range as well which isnt good.

When i click OK on the message box it then goes and so does the pasted content.
 
Last edited:
Upvote 0
Here is the pasted content that i need to stop happening.

4171.jpg
 
Upvote 0
I have found the culprit but need further help / advice.

In the code below the problem is the following .Apply

With it removed from the code the message box is shown & there is no pasted content BUT the list is out of order.
If i put the .Apply back in the message box then shows correctly & sorted BUT the pasted content is back.

How can i please have it sorted correctly but without the pasted content if .Apply is the reason ???

Code: 
Sub LEADERBOARD()    '' leaderboard Macro'    Range("C1:F17").Copy Range("I1")
    Worksheets("HONDA SHEET").Range("C1:D17").Copy Worksheets("SOLD ITEMS").Range("C2:D19")
    Worksheets("HONDA SHEET").Range("E1:F17").Copy Worksheets("SOLD ITEMS").Range("C19:D35")


    ActiveWorkbook.Worksheets("SOLD ITEMS").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("SOLD ITEMS").Sort.SortFields.Add Key:=Range("D2"), _
    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortTextAsNumbers
    With Worksheets("SOLD ITEMS").Sort
        .SetRange Range("C2:D35")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    With Worksheets("SOLD ITEMS").Range("C2:D35").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        End With
    Application.Goto Sheets("HONDA SHEET").Range("A5")
    Call Macro10
    End Sub
 
Upvote 0
All done now.

By adding the code below into the existing code now allows the item not to be seen.

Code: 
Range("A13").Select
 
Upvote 0
ipbr21054 said:
All done now.

By adding the code below into the existing code now allows the item not to be seen.

Code: 
Range("A13").Select
Click to expand...

I thought this was fixed but its not.
Having said that i do now see what the problem is but i do not know the answer to add in the edit code for the fix but i will explain what happens.

I click on the button of which then shows a table.
Behind the table is the blue background " as shown in photo example "

Now the fix for it not to be shown is this.
After i click on OK on the table i MUST click any cell BEFORE i click on the button again,this works.
If i click OK then click on the button again the blue background is shown each time.

SO THIS CYCLE WORKS FINE.
Click on the button,table is now shown.
Click OK,table now gone,
Click cell A13
Click the button,table is now shown on its own.

THIS IS THE PROBLEM
Click on the button,table is now shown & so is the blue background.
Click OK,table is now gone.
Also need to click on a cell to make blue background go.
Click on the button,table is now shown & so is the blue background.

Please advise how i add this to my code Range("A13").Select
i ASSUME IT GOES IN THE CODE BELOW SOMEWHERE ?

Code: 
Sub Macro10()'
' Macro10 Macro
'


'
Dim myStr As String
Dim x As Integer
Dim myRange As Range


Set myRange = Sheets("SOLD ITEMS").Range("C2:D35")




myData = myRange.Value




For x = 1 To UBound(myData, 1)
    myStr = myStr & myData(x, 1) & vbTab & myData(x, 2) & vbCrLf
Next x




MsgBox myStr


End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
Macro To Move Files - Will Not Move .msg or .csv files
Replies
4
Views
82
rachel06
R
C
  • Question Question
Using pattern searches with a variable to find the correct values
2
Replies
10
Views
197
chazrab
C
I
  • Question Question
Unable to run VBA code
Replies
1
Views
44
RoryA
RoryA
I
  • Solved
Simplify my working code please
Replies
7
Views
166
ipbr21054
I
A
  • Solved
VBA to declare column headers and use in further code
Replies
6
Views
442
AggieJess27
A

Forum statistics

Threads
1,223,911
Messages
6,175,326
Members
452,635
Latest member
laura12345

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