• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

combining vba codes

L

l_mirica

New Member
Hi all,

I know there are people like me (noobs) out there in search of crumbs.
So, I have made or found one piece of code, and my need evolved ... created or found another piece and so on ...

Before I give you my example I would like to invite you all to share your ideas, even if they might not work for me, they might still be very helpful for someone else.

and here are my codes that do NOT work as they do separately if I put them together (tried with 'call macro_name', writing into a single macro the whole thing, even telling excel to have a break between the two) but still no luck.

1st set of actions that I want:

Code: 
Sub conc_trans()
Dim rRange As Range
    On Error Resume Next
        Application.DisplayAlerts = False
            Set rRange = Application.InputBox(Prompt:= _
                "Selecteaza celule sau scrie aici", _
                    Title:="SPECIFY RANGE", Type:=8)
    On Error GoTo 0
        Application.DisplayAlerts = True
        If rRange Is Nothing Then
            Exit Sub
        Else
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=rRange, _
        SortOn:=xlSortOnValues, order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange rRange.CurrentRegion
        .HEADER = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Names.Add Name:="trans", RefersToR1C1:=rRange
    ActiveWorkbook.Names("trans").Comment = ""
    Selection.FormulaR1C1 = "=CONCATENATE(TRANSPOSE(trans&"",""))"
        End If
SendKeys "{F2}"
SendKeys "{F9}"
SendKeys "^~"
End Sub

and the second one:
Code: 
Sub CLR_selection()
    With Selection
        .Replace what:="=", replacement:="", lookat:=xlPart
        .Replace what:=" ", replacement:="", lookat:=xlPart
        .Replace what:=" ", replacement:="", lookat:=xlPart
        .Replace what:="{", replacement:="", lookat:=xlPart
        .Replace what:="}", replacement:="", lookat:=xlPart
        .Replace what:=""",""", replacement:="", lookat:=xlPart
        .Replace what:="""", replacement:="", lookat:=xlPart
    End With
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Offset(-1, 0).Select
    Selection.Copy
End Sub

thank you in advance for your thoughts, time and ideas !
 
First, a couple of bits that look strange and I don't understand.
What are these supposed to do?
Code: 
'SendKeys can be quite buggy...are you trying to recalculate?
SendKeys "{F2}"
SendKeys "{F9}"
SendKeys "^~"

'We change selection down, and then back up??
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(-1, 0).Select

As for your question, it sounds like you want to combine them into a single macro? The second macro would need a range to work on, currently being supplied by selection. I would recommend changing this to a defined range, such as rRange. Or, you can change the second macro to have an argument, and just leave it as it's own macro.

Code: 
Sub CLR_selection(myRange as Range)
   With myRange
        .Replace what:="=", replacement:="", lookat:=xlPart
        .Replace what:=" ", replacement:="", lookat:=xlPart
        .Replace what:=" ", replacement:="", lookat:=xlPart
        .Replace what:="{", replacement:="", lookat:=xlPart
        .Replace what:="}", replacement:="", lookat:=xlPart
        .Replace what:=""",""", replacement:="", lookat:=xlPart
        .Replace what:="""", replacement:="", lookat:=xlPart
   End With
End Sub
 
yes, I am trying to recalculate but could not find an alternative that works and if I do not move one cell down and then back up - else the result is buggy

as for the second part, I am open to suggestions - I do not have a 'static' reference and it would be great if I do not select it again, however, if put together with the other code it can use whatever it's already selected (wherever the previous result will lie in)
 
Try:
Application.Calculate
or
Worksheets("Sheet1").Calculate

Since you're defining rRange earlier in code, I'd change the whole thing to:
Code: 
Sub conc_trans()
Dim rRange As Range
    On Error Resume Next
    Application.DisplayAlerts = False
        Set rRange = Application.InputBox(Prompt:= _
            "Selecteaza celule sau scrie aici", _
                Title:="SPECIFY RANGE", Type:=8)
    On Error GoTo 0
    Application.DisplayAlerts = True
   
    If rRange Is Nothing Then Exit Sub
   
    Application.ScreenUpdating = False
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=rRange, _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange rRange.CurrentRegion
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Names.Add Name:="trans", RefersToR1C1:=rRange
    ActiveWorkbook.Names("trans").Comment = ""
    Selection.FormulaR1C1 = "=CONCATENATE(TRANSPOSE(trans&"",""))"
   
    With rRange
        .Replace what:="=", replacement:="", lookat:=xlPart
        .Replace what:=" ", replacement:="", lookat:=xlPart
        .Replace what:=" ", replacement:="", lookat:=xlPart
        .Replace what:="{", replacement:="", lookat:=xlPart
        .Replace what:="}", replacement:="", lookat:=xlPart
        .Replace what:=""",""", replacement:="", lookat:=xlPart
        .Replace what:="""", replacement:="", lookat:=xlPart
    End With
    Application.ScreenUpdating = True
   
    ActiveSheet.Calculate
End Sub
 
I would just make it one macro in the same way Luke has done.

Code: 
Option Explicit
 
Sub conc_trans()
Dim rRange As Range
Dim ar As Variant
Dim i As Integer
 
ar = [{"=", " ", "{",""",""",""""}]
On Error Resume Next
Application.DisplayAlerts = False
    Set rRange = Application.InputBox("Selecteaza celule sau scrie aici", "SPECIFY RANGE", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True
 
    If rRange Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
  
    rRange.CurrentRegion.Sort [a1], xlAscending, , , , , , xlYes
    ActiveWorkbook.Names.Add "trans", rRange
    ActiveWorkbook.Names("trans").Comment = ""
    Selection.Formula = "=CONCATENATE(TRANSPOSE(trans&"",""))" 'WHat cell is selected, better to tell XL where to place this.
  
    For i = 1 To UBound(ar)
        rRange.Replace ar(i), "", xlPart
    Next i
    Application.ScreenUpdating = True
End Sub

Take care

Smallman
 
both versions have the same result >=CONCATENATE(TRANSPOSE(trans&","))< in whatever cell I choose.

I am uploading a file as an example of what I am trying to pull.

It also has the buttons so you could see for yourself what I am talking about.

so - the first sheet will be having a table and the buttons and the others will mimic the result of each code (please keep in mind that I have to work with what I get - some tables are larger, some have more columns and not even in the same start or ... etc. the only thing that stays the same is that the data I need comes in one of the columns and pretty often I need the table to keep the data, so after the sort I may be able to check the details from the table.
 

Attachments

  • join_codes.xlsm
    43.9 KB · Views: 2
Hi ,

I am sure someone will respond ; however , my suggestion would be :

Instead of asking members of this forum to correct / modify code which you have put together from here and there , you might get an answer faster if you could clearly describe what you want done. There are enough good programmers here who can come up with the required code in far less time than the 18 hours that have already elapsed since your first post.

Narayan
 
sorry for wasting your time. however my thought was to make people come here for various solutions instead of looking for punctual resolve.
for me it is way easier to learn by testing and searching and understanding pieces of code. I have a job that does not require any programming but I would like to learn it anyway. it is not my intention to bother others even if they do not have anything better to do (and I am sure here are plenty of things way better to do at any time)

if I have crossed any line, I apologize and you can close/delete this thread and let me thank you anyway !

if not I believe now it's more clear what I would like to do with the data - imagine that instead of clicking the next sheet you click on those buttons executing the macros. I'd like to skip a click, if possible.

and yes, you are right, it did not crossed my mind to explain good enough. sometimes, when you hit a dead end, it's easier to just change the whole thing ! I hope I'll remember this more often !
 
could you please direct me to some reading material so I could understand (and hopefully apply this method):
Code: 
ar = [{"=", " ", "{",""",""",""""}]
 
Hi ,

I think you have misunderstood me !

I was trying to save you from having your time wasted , in waiting for an answer or in getting your problem resolved ; this is because , in general , it is more time-consuming and inconvenient for a programmer to go through someone else's code , and then understand what that code is doing , than to go through a clear functional specification and write the code from scratch ; this is especially so where the code is not for a generic routine , e.g. a search or sort routine.

You have not crossed any line , and there's no need to apologize ; this is a public forum , and whoever wants to respond to your problem is free to do so.

I have not understood what exactly you wish to do , so I will leave it to Luke or Marcus , since they have already posted answers earlier.

Narayan
 
Hi @l_mirica

could you please direct me to some reading material so I could understand (and hopefully apply this method):
Click to expand...

This is simply an array variant. The way it is written is the same as typing;

ar = array("=", " ", "{",""",""","""")

with the added advantage the square brackets ensure the array starts at 1 not 0 as is the case with the method above. Then any loop can start with 1 a more intuitive figure to start with.

The above is a one dimensional array. A simple array. The array becomes more useful as a two dimensional or multi dimensional array where you assign information from the worksheet to the array.

If you lookup vba arrays there is a wealth of reading on the subject.

Take care

Smallman
 
I know it's been ages since I've started and thank you all for your input.
I have managed to achieve all of it in a singe macro by using array.
arrays are really powerful but a little more complex

anyway, here is the new code:
Code: 
Sub conc_trans()
Dim rRange, Re, cell As Range, OutStr As String
Set Re = ActiveCell
    On Error Resume Next
        Application.DisplayAlerts = False
            Set rRange = Application.InputBox("Column", "Selected cells", Type:=8)
    On Error GoTo 0
        Application.DisplayAlerts = True
        If IsEmpty(rRange) Then
            Exit Sub
        Else
Unload Me
    rRange.Activate
    rRange.RemoveDuplicates Columns:=1, HEADER:=xlNo
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=ActiveCell _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range(ActiveCell.End(xlToLeft), Cells(ActiveCell.End(xlDown).row, ActiveCell.End(xlToRight).Column))
        .HEADER = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
For Each cell In rRange
    If cell.Text <> "" Then
        OutStr = OutStr & Trim(cell.Text) & ","
    End If
Next
Re.Select
Re.Value = Left(OutStr, Len(OutStr) - 1)
        End If
End Sub
 
You must log in or register to reply here.
Back
Top