ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,638
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
 

Some videos you may like

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,445
Office Version
  1. 2013
Platform
  1. Windows
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
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,638
Office Version
  1. 2007
Platform
  1. Windows
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:

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,638
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

Here is the pasted content that i need to stop happening.

 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,638
Office Version
  1. 2007
Platform
  1. Windows
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
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,638
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

Do you see why this is happening.

Thanks.
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,638
Office Version
  1. 2007
Platform
  1. Windows
All done now.

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

Code:
Range("A13").Select
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,638
Office Version
  1. 2007
Platform
  1. Windows
All done now.

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

Code:
Range("A13").Select

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
 

Watch MrExcel Video

Forum statistics

Threads
1,109,143
Messages
5,527,072
Members
409,743
Latest member
sukuto20

This Week's Hot Topics

Top