Macro to be there in single Button.

**shekar goud** · 04-07-2009, 07:23 AM

Hi Team,

I have a macro which was developed with the help of our Experts.

I need all that macros to be in 1 button would that be possible.

I have tried this but not able to make it.

Any Help is Greatly Appreciated.



Sub x()

    Dim lngRow As Long
    Dim pvtTable As PivotTable
    Dim blnHasName As Boolean
    
    Set pvtTable = ActiveSheet.PivotTables(1)
    With pvtTable.TableRange1
        ' clear column to right of table
        .Columns(1).Offset(, .Columns.Count).Clear
        For lngRow = 2 To .Rows.Count
            If Right(.Cells(lngRow, 1), 5) = "Total" Then
                If blnHasName Then
                    .Cells(lngRow, 1).Offset(, .Columns.Count).Value = .Cells(lngRow, .Columns.Count).Value
                    .Cells(lngRow, 1).Offset(, .Columns.Count).Interior.ColorIndex = 39
             End If
                blnHasName = False
            ElseIf InStr(1, .Cells(lngRow, 3), "PIMCO", vbTextCompare) > 0 Then
                blnHasName = True
          End If
      Next
    End With
    Columns("N:N").Select
    Selection.Copy
    Columns("O:O").Select
    ActiveSheet.Paste
    Columns("N:N").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Selection.Interior.ColorIndex = 2
 
 
 End Sub


Sub Y()

    Dim lngRow As Long
    Dim pvtTable As PivotTable
    Dim blnHasName As Boolean
    
    Set pvtTable = ActiveSheet.PivotTables(1)
    With pvtTable.TableRange1
        ' clear column to right of table
        .Columns(1).Offset(, .Columns.Count).Clear
        For lngRow = 1 To .Rows.Count
            If Right(.Cells(lngRow, 1), 5) = "Total" Then
                If blnHasName Then
                    .Cells(lngRow, 1).Offset(, .Columns.Count).Value = .Cells(lngRow, .Columns.Count).Value
                    .Cells(lngRow, 1).Offset(, .Columns.Count).Interior.ColorIndex = 6
             End If
                blnHasName = False
            ElseIf InStr(1, .Cells(lngRow, 3), "Repo", vbTextCompare) > 0 Then
                blnHasName = True
            End If
           
              
         Next
    End With
    

End Sub

Sub Deletemove()
 Columns("N:N").Select
    Range("N16").Activate
    Selection.Copy
    Columns("O:O").Select
    Range("O16").Activate
    Selection.Insert Shift:=xlToRight
    Columns("N:N").Select
    Range("N16").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
End Sub


Sub EmeItalian()

    Dim lngRow As Long
    Dim pvtTable As PivotTable
    Dim blnHasName As Boolean
    
    Set pvtTable = ActiveSheet.PivotTables(1)
    With pvtTable.TableRange1
        ' clear column to right of table
        .Columns(1).Offset(, .Columns.Count).Clear
        For lngRow = 1 To .Rows.Count
            If Right(.Cells(lngRow, 1), 5) = "Total" Then
                If blnHasName Then
                    .Cells(lngRow, 1).Offset(, .Columns.Count).Value = .Cells(lngRow, .Columns.Count).Value
                    .Cells(lngRow, 1).Offset(, .Columns.Count).Interior.ColorIndex = 3
             End If
                blnHasName = False
            ElseIf InStr(1, .Cells(lngRow, 1), "IT000", vbTextCompare) > 0 Then
                blnHasName = True
           
           End If
         Next
    End With
    
   Columns("K:K").Select
    Range("K16").Activate
    Selection.Copy
    Columns("L:L").Select
    Range("L16").Activate
    Selection.Insert Shift:=xlToRight
    Columns("K:K").Select
    Range("K16").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
 
    End With
End Sub


Sub repoemea()
 
 Dim lngRow As Long
    Dim pvtTable As PivotTable
    Dim blnHasName As Boolean
    
    Set pvtTable = ActiveSheet.PivotTables(1)
    With pvtTable.TableRange1
        ' clear column to right of table
        .Columns(1).Offset(, .Columns.Count).Clear
        For lngRow = 1 To .Rows.Count
            If Right(.Cells(lngRow, 1), 5) = "Total" Then
                If blnHasName Then
                    .Cells(lngRow, 1).Offset(, .Columns.Count).Value = .Cells(lngRow, .Columns.Count).Value
                    .Cells(lngRow, 1).Offset(, .Columns.Count).Interior.ColorIndex = 36
             End If
                blnHasName = False
            ElseIf InStr(1, .Cells(lngRow, 3), "Repo", vbTextCompare) > 0 Then
                blnHasName = True
            End If
             Next
    End With
    
    Columns("K:K").Select
    Range("K16").Activate
    Selection.Copy
    Columns("L:L").Select
    Range("L16").Activate
    Selection.Insert Shift:=xlToRight
    Columns("K:K").Select
    Range("K16").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
  
End Sub



Sub LandGemea()
 
 Dim lngRow As Long
    Dim pvtTable As PivotTable
    Dim blnHasName As Boolean
    
    Set pvtTable = ActiveSheet.PivotTables(1)
    With pvtTable.TableRange1
        ' clear column to right of table
        .Columns(1).Offset(, .Columns.Count).Clear
        For lngRow = 1 To .Rows.Count
            If Right(.Cells(lngRow, 1), 5) = "Total" Then
                If blnHasName Then
                    .Cells(lngRow, 1).Offset(, .Columns.Count).Value = .Cells(lngRow, .Columns.Count).Value
                    .Cells(lngRow, 1).Offset(, .Columns.Count).Interior.ColorIndex = 46
             End If
                blnHasName = False
            ElseIf InStr(1, .Cells(lngRow, 3), "LEGAL AND GENERAL", vbTextCompare) > 0 Then
                blnHasName = True
            ElseIf InStr(1, .Cells(lngRow, 3), "LEGAL & GENERAL", vbTextCompare) > 0 Then
                blnHasName = True
           End If
             Next
    End With
    
    Columns("K:K").Select
    Range("K16").Activate
    Selection.Copy
    Columns("L:L").Select
    Range("L16").Activate
    Selection.Insert Shift:=xlToRight
    Columns("K:K").Select
    Range("K16").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
  
End Sub



Sub DanskEmea()
 
 Dim lngRow As Long
    Dim pvtTable As PivotTable
    Dim blnHasName As Boolean
    
    Set pvtTable = ActiveSheet.PivotTables(1)
    With pvtTable.TableRange1
        ' clear column to right of table
        .Columns(1).Offset(, .Columns.Count).Clear
        For lngRow = 1 To .Rows.Count
            If Right(.Cells(lngRow, 1), 5) = "Total" Then
                If blnHasName Then
                    .Cells(lngRow, 1).Offset(, .Columns.Count).Value = .Cells(lngRow, .Columns.Count).Value
                    .Cells(lngRow, 1).Offset(, .Columns.Count).Interior.ColorIndex = 45
             End If
                blnHasName = False
            ElseIf InStr(1, .Cells(lngRow, 3), "DANSKE", vbTextCompare) > 0 Then
                blnHasName = True
                       End If
             Next
    End With
    
    Columns("K:K").Select
    Range("K16").Activate
    Selection.Copy
    Columns("L:L").Select
    Range("L16").Activate
    Selection.Insert Shift:=xlToRight
    Columns("K:K").Select
    Range("K16").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
  
End Sub

Thanks & Regards,
Shekar Goud.

**mudraker** · 04-07-2009, 08:12 AM

Have the macro attached to the button call the other macro's

Sub MainMacro
call macro1
call macro2
call macro3
end sub

**shekar goud** · 04-07-2009, 09:02 AM

Hi Mudraker,

Thanks for your intrest I have tried this but unforunate not succeded.

Private Sub CommandButton1_Click()
Call x
Call Y
Call EmeItalian
Call repoemea
Call LandGemea
Call DanskEmea

End Sub

Regards,
Shekar.

**shekar goud** · 04-07-2009, 10:39 AM

Hi Team,

Any Luck on the above.

Regards,
Shekar.

**Andy Pope** · 04-07-2009, 12:01 PM

pretty though the picture is it does not provide us with the information to resolve your problem.

Which routine fails?
What line in that routine fails?

If you manually run each macro 1 after the other do you still get the error msg?

**shekar goud** · 04-08-2009, 03:38 AM

Hi Andy,

When i Run Manullay each macro works very well but when i called the macros in one then i encounter with this kind of error in evry macro.

Is there any possiblity of resolving please suggest.

Iam just an begginer in VBA.

Regards,
Shekar.

**Andy Pope** · 04-08-2009, 04:40 AM

probably but you didn't answer all the questions.

where exactly does the error occur?

you could try setting the TakeFocusOnClick property of the button to False

Can you post workbook example

**shekar goud** · 04-08-2009, 06:01 AM

Hi Andy,

Thanks for all your Support.

I did something to get the solution and that is working fine.

In the code after Every End With i need an code which can copy the active column to next left column.

Now i Need is Copy the active column and paste it to next left column.I have tried this but getting an error.


Private Sub CommandButton2_Click()
    Dim Rit As range
    Dim lngRow1 As Long
    Dim pvtTable1 As PivotTable
    Dim blnHasName1 As Boolean
    Dim lngRow2 As Long
    Dim pvtTable2 As PivotTable
    Dim blnHasName2 As Boolean
    Dim lngRow3 As Long
    Dim pvtTable3 As PivotTable
    Dim blnHasName3 As Boolean
    Dim lngRow4 As Long
    Dim pvtTable4 As PivotTable
    Dim blnHasName4 As Boolean
    Dim lngRow5 As Long
    Dim pvtTable5 As PivotTable
    Dim blnHasName5 As Boolean
    Dim lngRow6 As Long
    Dim pvtTable6 As PivotTable
    Dim blnHasName6 As Boolean
    
    
    Sheets("sheet1").Select
    Set pvtTable1 = ActiveSheet.PivotTables(1)
    With pvtTable1.TableRange1
        ' clear column to right of table
        .Columns(1).Offset(, .Columns.Count).Clear
        For lngRow1 = 1 To .Rows.Count
            If Right(.Cells(lngRow1, 1), 5) = "Total" Then
                If blnHasName1 Then
                    .Cells(lngRow1, 1).Offset(, .Columns.Count).Value = .Cells(lngRow1, .Columns.Count).Value
                    .Cells(lngRow1, 1).Offset(, .Columns.Count).Interior.ColorIndex = 39
             End If
                blnHasName1 = False
            ElseIf InStr(1, .Cells(lngRow1, 3), "PIMCO", vbTextCompare) > 0 Then
                blnHasName1 = True
            End If
            Next
         End With
        
      
    
   
    Set pvtTable2 = ActiveSheet.PivotTables(1)
    With pvtTable2.TableRange1
              
        
        ' clear column to right of table
        .Columns(2).Offset(2, .Columns.Count).Clear
        For lngRow2 = 1 To .Rows.Count
            If Right(.Cells(lngRow2, 1), 5) = "Total" Then
                If blnHasName2 Then
                    .Cells(lngRow2, 1).Offset(, .Columns.Count).Value = .Cells(lngRow2, .Columns.Count).Value
                    .Cells(lngRow2, 1).Offset(, .Columns.Count).Interior.ColorIndex = 6
             End If
                blnHasName2 = False
            ElseIf InStr(1, .Cells(lngRow2, 3), "Repo", vbTextCompare) > 0 Then
                blnHasName2 = True
            End If
                       
         Next
    End With
    
    
    Sheets("sheet4").Select
    Set pvtTable3 = ActiveSheet.PivotTables(1)
    With pvtTable3.TableRange1
        ' clear column to right of table
        .Columns(1).Offset(, .Columns.Count).Clear
        For lngRow3 = 1 To .Rows.Count
            If Right(.Cells(lngRow3, 1), 5) = "Total" Then
                If blnHasName3 Then
                    .Cells(lngRow3, 1).Offset(, .Columns.Count).Value = .Cells(lngRow3, .Columns.Count).Value
                    .Cells(lngRow3, 1).Offset(, .Columns.Count).Interior.ColorIndex = 3
             End If
                blnHasName3 = False
            ElseIf InStr(1, .Cells(lngRow3, 1), "IT000", vbTextCompare) > 0 Then
                blnHasName3 = True
           
           End If
         Next
    End With
    
    Set pvtTable4 = ActiveSheet.PivotTables(1)
    With pvtTable4.TableRange1
        ' clear column to right of table
        .Columns(2).Offset(2, .Columns.Count).Clear
        For lngRow4 = 1 To .Rows.Count
            If Right(.Cells(lngRow4, 1), 5) = "Total" Then
                If blnHasName4 Then
                    .Cells(lngRow4, 1).Offset(, .Columns.Count).Value = .Cells(lngRow4, .Columns.Count).Value
                    .Cells(lngRow4, 1).Offset(, .Columns.Count).Interior.ColorIndex = 36
             End If
                blnHasName4 = False
            ElseIf InStr(1, .Cells(lngRow4, 3), "Repo", vbTextCompare) > 0 Then
                blnHasName4 = True
            End If
               
             Next
    End With
    
    Set pvtTable5 = ActiveSheet.PivotTables(1)
    With pvtTable5.TableRange1
        ' clear column to right of table
        .Columns(3).Offset(3, .Columns.Count).Clear
        For lngRow5 = 3 To .Rows.Count
            If Right(.Cells(lngRow5, 1), 5) = "Total" Then
                If blnHasName5 Then
                    .Cells(lngRow5, 1).Offset(, .Columns.Count).Value = .Cells(lngRow5, .Columns.Count).Value
                    .Cells(lngRow5, 1).Offset(, .Columns.Count).Interior.ColorIndex = 46
             End If
                blnHasName5 = False
            ElseIf InStr(1, .Cells(lngRow5, 1), "LEGAL AND GENERAL", vbTextCompare) > 0 Then
                blnHasName5 = True
            ElseIf InStr(1, .Cells(lngRow5, 1), "LEGAL & GENERAL", vbTextCompare) > 0 Then
                blnHasName5 = True
           End If
             Next
    End With
    Columns("K:K").Select
    range("K16").Activate
    Selection.Copy
    Columns("L:L").Select
    range("L16").Activate
    Selection.Insert Shift:=xlToRight
    Columns("K:K").Select
    range("K16").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
    
        
    
     Set pvtTable6 = ActiveSheet.PivotTables(1)
    With pvtTable6.TableRange1
        ' clear column to right of table
        .Columns(4).Offset(4, .Columns.Count).Clear
        For lngRow6 = 1 To .Rows.Count
            If Right(.Cells(lngRow6, 1), 5) = "Total" Then
                If blnHasName6 Then
                    .Cells(lngRow6, 1).Offset(, .Columns.Count).Value = .Cells(lngRow6, .Columns.Count).Value
                    .Cells(lngRow6, 1).Offset(, .Columns.Count).Interior.ColorIndex = 45
             End If
                blnHasName6 = False
            ElseIf InStr(1, .Cells(lngRow6, 3), "DANSKE", vbTextCompare) > 0 Then
                blnHasName6 = True
                       End If
             Next
    End With
    
        
    
    

End Sub

Iam attaching the pic of both error and when i tried to put the same in code.

Please kindly help me.

Regards,
Shekar.

**shekar goud** · 04-09-2009, 03:34 AM

Hi Team,

I have struggling to reslove this could someone please give a solution.

iam Attaching an excel sheet.

1) In Column J(can be moved to i,J,K) i need the total of "Wright" iam adding the code aslo.

2) In Column K(can be sometimes moved to J,K,L,M)i need the total of "Shekar" iam adding the code too.

3)And finally I need all this in One Click Button.

Please Kindly help me .


Sub shekar()

    Dim lngRow1 As Long
    Dim pvtTable1 As PivotTable
    Dim blnHasName1 As Boolean
    
    Set pvtTable1 = ActiveSheet.PivotTables(1)
    With pvtTable1.TableRange1
        ' clear column to right of table
        .Columns(1).Offset(, .Columns.Count).Clear
        For lngRow1 = 2 To .Rows.Count
            If Right(.Cells(lngRow1, 1), 5) = "Total" Then
                If blnHasName1 Then
                    .Cells(lngRow1, 1).Offset(, .Columns.Count).Value = .Cells(lngRow1, .Columns.Count).Value
                    .Cells(lngRow1, 1).Offset(, .Columns.Count).Interior.ColorIndex = 39
             End If
                blnHasName1 = False
            ElseIf InStr(1, .Cells(lngRow1, 3), "shekar", vbTextCompare) > 0 Then
                blnHasName1 = True
          End If
      Next
    End With
    
 
 End Sub


Sub Wright()

    Dim lngRow2 As Long
    Dim pvtTable2 As PivotTable
    Dim blnHasName2 As Boolean
    
    Set pvtTable2 = ActiveSheet.PivotTables(1)
    With pvtTable2.TableRange1
        ' clear column to right of table
        .Columns(1).Offset(, .Columns.Count).Clear
        For lngRow2 = 1 To .Rows.Count
            If Right(.Cells(lngRow2, 1), 5) = "Total" Then
                If blnHasName2 Then
                    .Cells(lngRow2, 1).Offset(, .Columns.Count).Value = .Cells(lngRow2, .Columns.Count).Value
                    .Cells(lngRow2, 1).Offset(, .Columns.Count).Interior.ColorIndex = 6
             End If
                blnHasName2 = False
            ElseIf InStr(1, .Cells(lngRow2, 3), "Wright", vbTextCompare) > 0 Then
                blnHasName2 = True
            End If
           
              
         Next
    End With
    

End Sub

Regards,
Shekar.

**Andy Pope** · 04-09-2009, 05:08 AM

Assuming your routines all work this runnings without error.

**shekar goud** · 04-09-2009, 05:24 AM

Brilliant since 4 days iam struggling for this Hats off to you.

But still My Button dream remains same.

Once Again thanks to you Andy.

Regards,
Shekar.

**Andy Pope** · 04-09-2009, 05:37 AM

What button dream? Did you not try the one on the sheet by cell U13 ?

**shekar goud** · 04-09-2009, 05:43 AM

Ohhhh really excellent.iam sorry i did'nt watched it.

Really great thanks for all your help Andy.

Regards,
Shekar.

Macro to be there in single Button.

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Macro to be there in single Button.

Re: Macro to be there in single Button.

Re: Macro to be there in single Button.

Re: Macro to be there in single Button.

Re: Macro to be there in single Button.

Re: Macro to be there in single Button.

Re: Macro to be there in single Button.

Re: Macro to be there in single Button.

Re: Macro to be there in single Button.

Re: Macro to be there in single Button.

Re:[Solved]Macro to be there in single Button.

Re: Macro to be there in single Button.

Re: Macro to be there in single Button.

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions