Combining TWO buttons operations into ONE

Z

Zahid0111

New Member
Joined
Mar 8, 2020
Messages
23
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I have two buttons in my workbook, they perform different operation by importing data from same workbook but different sheets. I want to combine this into one button, please help me with this.
Button 1 Code is:
VBA Code: 
Private Sub CommandButton1_Click()
    'Sheets("RawDataChamla").Visible = True
    Dim fn As String
    Const wsName As String = "Grade Wise"
    fn = Application.GetOpenFilename("ExcelFiles,*.xls?")
    If fn = "False" Then Exit Sub
    If Not IsSheetExistsIn(wsName, fn) Then
        MsgBox Chr(34) & wsName & Chr(34) & " not found in " & fn: Exit Sub
    End If
    Dim cn As Object, rs As Object
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    With cn
        .Provider = "Microsoft.Ace.OLEDB.12.0"
        .Properties("Extended Properties") = "Excel 12.0;HDR=No;"
        .Open fn
    End With
    rs.Open "Select * From [" & wsName & "$a2:e50000] Where F1 Is Not Null;", cn
    Sheets("RawDataChamla").Range("a" & Rows.Count).End(xlUp)(2).CopyFromRecordset rs
    'Sheets("RawDataChamla").Select
    Set cn = Nothing: Set rs = Nothing
    Chamla
End Sub

Button 2 Code is:
VBA Code: 
Private Sub CommandButton2_Click()
' Copy data from farmer history sheet to main sheet
Dim srcWB As Workbook
    Dim rCl As Range
    Dim rC2 As Range
    Dim rC3 As Range
    Dim rC4 As Range
    Dim rC5 As Range
    Dim rC6 As Range
    Dim rC7 As Range
    Dim rC8 As Range
    Dim FileToOpen As Variant

    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for file Farmer History Gradewise(Chamla)", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set srcWB = Application.Workbooks.Open(FileToOpen)
        With srcWB.Sheets("Farmer History")
            Set rCl = .Range("A1").CurrentRegion.Rows(1).Find(What:="  Crop Area", LookIn:=xlValues)
            If Not rCl Is Nothing Then .Range(rCl, rCl.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("F13")
            
            Set rC2 = .Range("A1").CurrentRegion.Rows(1).Find(What:="  Target Qty", LookIn:=xlValues)
            If Not rC2 Is Nothing Then .Range(rC2, rC2.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("R13")
            
            Set rC3 = .Range("A1").CurrentRegion.Rows(1).Find(What:="Cumulative Sold", LookIn:=xlValues)
            If Not rC3 Is Nothing Then .Range(rC3, rC3.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("S13")
            
            Set rC4 = .Range("A1").CurrentRegion.Rows(1).Find(What:="Village Code", LookIn:=xlValues)
            If Not rC4 Is Nothing Then .Range(rC4, rC4.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("E13")
            
            Set rC5 = .Range("A1").CurrentRegion.Rows(1).Find(What:="Father Name", LookIn:=xlValues)
            If Not rC5 Is Nothing Then .Range(rC5, rC5.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("D13")
            
            Set rC6 = .Range("A1").CurrentRegion.Rows(1).Find(What:="Farmer Name", LookIn:=xlValues)
            If Not rC6 Is Nothing Then .Range(rC6, rC6.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("C13")
            
            Set rC7 = .Range("A1").CurrentRegion.Rows(1).Find(What:="Farmer No.", LookIn:=xlValues)
            If Not rC7 Is Nothing Then .Range(rC7, rC7.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("B13")
            
        End With
        
        srcWB.Close False

    End If
    Application.ScreenUpdating = True
    
LineAll4

End Sub
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Sort by date Sort by votes
delete the 2 buttons, the code will remain.
add new button3

Code: 
sub commandButton3_click()
CommandButton1_Click
CommandButton2_Click
end sub
 
Upvote 0
But as you can see in the code, both buttons ask for file to select, how to deal with it
 
Upvote 0
@Zahid0111
Your post has been reported as being cross posted with another site.

While we do allow Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

Please provide the link(s)
 
Upvote 0
One way (didn't test) ...

VBA Code: 
Private Sub CommandButton3_Click()
    CommandButton2_Click CommandButton1_Click 
End Sub

Private Sub CommandButton1_Click() As Variant
    'Sheets("RawDataChamla").Visible = True
    Dim fn As String
    Const wsName As String = "Grade Wise"
    fn = Application.GetOpenFilename("ExcelFiles,*.xls?")
    If fn = "False" Then Exit Sub
    fileName = fn
    If Not IsSheetExistsIn(wsName, fn) Then
        MsgBox Chr(34) & wsName & Chr(34) & " not found in " & fn: Exit Sub
    End If
    Dim cn As Object, rs As Object
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    With cn
        .Provider = "Microsoft.Ace.OLEDB.12.0"
        .Properties("Extended Properties") = "Excel 12.0;HDR=No;"
        .Open fn
    End With
    rs.Open "Select * From [" & wsName & "$a2:e50000] Where F1 Is Not Null;", cn
    Sheets("RawDataChamla").Range("a" & Rows.Count).End(xlUp)(2).CopyFromRecordset rs
    'Sheets("RawDataChamla").Select
    Set cn = Nothing: Set rs = Nothing
    Chamla
    CommandButton1_Click = fn
End Sub

Private Sub CommandButton2_Click(fileName As Variant)
' Copy data from farmer history sheet to main sheet
Dim srcWB As Workbook
    Dim rCl As Range
    Dim rC2 As Range
    Dim rC3 As Range
    Dim rC4 As Range
    Dim rC5 As Range
    Dim rC6 As Range
    Dim rC7 As Range
    Dim rC8 As Range
    Dim FileToOpen As Variant

    Application.ScreenUpdating = False
    'FileToOpen = Application.GetOpenFilename(Title:="Browse for file Farmer History Gradewise(Chamla)", FileFilter:="Excel Files (*.xls*),*xls*")
    FileToOpen = fileName
    If FileToOpen <> False Then
        Set srcWB = Application.Workbooks.Open(FileToOpen)
        With srcWB.Sheets("Farmer History")
            Set rCl = .Range("A1").CurrentRegion.Rows(1).Find(What:="  Crop Area", LookIn:=xlValues)
            If Not rCl Is Nothing Then .Range(rCl, rCl.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("F13")
            
            Set rC2 = .Range("A1").CurrentRegion.Rows(1).Find(What:="  Target Qty", LookIn:=xlValues)
            If Not rC2 Is Nothing Then .Range(rC2, rC2.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("R13")
            
            Set rC3 = .Range("A1").CurrentRegion.Rows(1).Find(What:="Cumulative Sold", LookIn:=xlValues)
            If Not rC3 Is Nothing Then .Range(rC3, rC3.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("S13")
            
            Set rC4 = .Range("A1").CurrentRegion.Rows(1).Find(What:="Village Code", LookIn:=xlValues)
            If Not rC4 Is Nothing Then .Range(rC4, rC4.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("E13")
            
            Set rC5 = .Range("A1").CurrentRegion.Rows(1).Find(What:="Father Name", LookIn:=xlValues)
            If Not rC5 Is Nothing Then .Range(rC5, rC5.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("D13")
            
            Set rC6 = .Range("A1").CurrentRegion.Rows(1).Find(What:="Farmer Name", LookIn:=xlValues)
            If Not rC6 Is Nothing Then .Range(rC6, rC6.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("C13")
            
            Set rC7 = .Range("A1").CurrentRegion.Rows(1).Find(What:="Farmer No.", LookIn:=xlValues)
            If Not rC7 Is Nothing Then .Range(rC7, rC7.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("B13")
            
        End With
        
        srcWB.Close False

    End If
    Application.ScreenUpdating = True
    
LineAll4

End Sub
 
Upvote 0
Dear, attached are the snapshots of the errors.
 

Attachments

  • error 1.PNG
    error 1.PNG
    27.1 KB · Views: 12
  • error 2.PNG
    error 2.PNG
    37.9 KB · Views: 13
  • error 3.PNG
    error 3.PNG
    32.4 KB · Views: 14
  • error 4.PNG
    error 4.PNG
    24.5 KB · Views: 13
Upvote 0
Like I said... didn't test it. :) Try this?

VBA Code: 
Private Sub CommandButton3_Click()
    CommandButton2_Click fileName:=CommandButton1_Click 
End Sub

Private Function CommandButton1_Click() As Variant
    'Sheets("RawDataChamla").Visible = True
    Dim fn As String
    Const wsName As String = "Grade Wise"
    fn = Application.GetOpenFilename("ExcelFiles,*.xls?")
    
    If fn = "False" Then 
        CommandButton1_Click = False
        Exit Function
    End If
    
    If Not IsSheetExistsIn(wsName, fn) Then
        MsgBox Chr(34) & wsName & Chr(34) & " not found in " & fn
        CommandButton1_Click = False
        Exit Function
    End If
    Dim cn As Object, rs As Object
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    With cn
        .Provider = "Microsoft.Ace.OLEDB.12.0"
        .Properties("Extended Properties") = "Excel 12.0;HDR=No;"
        .Open fn
    End With
    rs.Open "Select * From [" & wsName & "$a2:e50000] Where F1 Is Not Null;", cn
    Sheets("RawDataChamla").Range("a" & Rows.Count).End(xlUp)(2).CopyFromRecordset rs
    'Sheets("RawDataChamla").Select
    Set cn = Nothing: Set rs = Nothing
    Chamla
    CommandButton1_Click = fn
End Function

Private Sub CommandButton2_Click(fileName As Variant)
' Copy data from farmer history sheet to main sheet
Dim srcWB As Workbook
    Dim rCl As Range
    Dim rC2 As Range
    Dim rC3 As Range
    Dim rC4 As Range
    Dim rC5 As Range
    Dim rC6 As Range
    Dim rC7 As Range
    Dim rC8 As Range
    Dim FileToOpen As Variant

    Application.ScreenUpdating = False
    'FileToOpen = Application.GetOpenFilename(Title:="Browse for file Farmer History Gradewise(Chamla)", FileFilter:="Excel Files (*.xls*),*xls*")
    FileToOpen = fileName
    If FileToOpen <> False Then
        Set srcWB = Application.Workbooks.Open(FileToOpen)
        With srcWB.Sheets("Farmer History")
            Set rCl = .Range("A1").CurrentRegion.Rows(1).Find(What:="  Crop Area", LookIn:=xlValues)
            If Not rCl Is Nothing Then .Range(rCl, rCl.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("F13")
            
            Set rC2 = .Range("A1").CurrentRegion.Rows(1).Find(What:="  Target Qty", LookIn:=xlValues)
            If Not rC2 Is Nothing Then .Range(rC2, rC2.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("R13")
            
            Set rC3 = .Range("A1").CurrentRegion.Rows(1).Find(What:="Cumulative Sold", LookIn:=xlValues)
            If Not rC3 Is Nothing Then .Range(rC3, rC3.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("S13")
            
            Set rC4 = .Range("A1").CurrentRegion.Rows(1).Find(What:="Village Code", LookIn:=xlValues)
            If Not rC4 Is Nothing Then .Range(rC4, rC4.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("E13")
            
            Set rC5 = .Range("A1").CurrentRegion.Rows(1).Find(What:="Father Name", LookIn:=xlValues)
            If Not rC5 Is Nothing Then .Range(rC5, rC5.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("D13")
            
            Set rC6 = .Range("A1").CurrentRegion.Rows(1).Find(What:="Farmer Name", LookIn:=xlValues)
            If Not rC6 Is Nothing Then .Range(rC6, rC6.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("C13")
            
            Set rC7 = .Range("A1").CurrentRegion.Rows(1).Find(What:="Farmer No.", LookIn:=xlValues)
            If Not rC7 Is Nothing Then .Range(rC7, rC7.End(xlDown)).Offset(1).copy ThisWorkbook.Sheets("Chamla").Range("B13")
            
        End With
        
        srcWB.Close False

    End If
    Application.ScreenUpdating = True
    
LineAll4

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

Similar threads

J
  • Question Question
VBA Search box and button code
Replies
0
Views
247
jlcodes
J
C
  • Question Question
How would i use the FIND method with the AND operator to find any two words in a sheet cell, i.e., "understanding" AND "heart"
2
Replies
11
Views
528
Trebor76
T
T
  • Solved
Help with VBA Code in Excel
Replies
2
Views
306
tixarah
T
C
  • Question Question
Combining rows 3 through 7 into row 2, one row takes a painfully long time with this code. Why?
Replies
2
Views
247
jolivanes
jolivanes
S
  • Solved
Diagonal Sum in excel table via VBA code
2
Replies
11
Views
492
myall_blues
myall_blues

Forum statistics

Threads
1,223,893
Messages
6,175,241
Members
452,622
Latest member
Laura_PinksBTHFT

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