Possible to Convert Excel Program to Access

S

shabee417

New Member
Joined
Mar 20, 2011
Messages
4
Hai

I have a Program with excel vba i would like to convert to access is it possible

Thanks
Shabee

Code


Code: 
Option Explicit


Dim blnNew As Boolean
Dim TRows, i As Long


Private Sub cmdClose_Click()
    If cmdClose.Caption = "Close" Then
        Unload Me
    Else
        cmdClose.Caption = "Close"
        cmdNew.Enabled = True
        cmdDelete.Enabled = True
        
    End If
End Sub


Private Sub cmdDelete_Click()
    TRows = Worksheets("Data").Range("A1").CurrentRegion.Rows.Count
    Dim strDel
    strDel = MsgBox("Delete ?", vbYesNo, "Delete")
    If strDel = vbYes Then
        For i = 1 To TRows
            If Trim(Worksheets("Data").Cells(i, 1).Value) = Trim(txtCollectionNo.Text) Then
                
              '  Sheet1.Range(i & ":" & i).Delete
                Worksheets("Data").Range(i & ":" & i).Delete
                
            txtCollectionNo.Text = ""
            txtCustomerName.Text = ""
            txtContact.Text = ""
            txtIMEI.Text = ""
            txtPhonemodel.Text = ""
            txtProblem.Text = ""
            txtCondition.Text = ""
            txtCost.Text = ""
            CheckBox1.Value = 0
            CheckBox2.Value = 0
            CheckBox3.Value = 0
            txtStatus.Text = ""
            txtSPRUsed.Text = ""
            txtCharge.Text = ""
            txtDate.Text = ""
            
            Call prComboBoxFill
                
                Exit For
            End If
        Next i
        If Trim(ComboBox1.Text) = "" Then
            cmdSave.Enabled = False
            cmdDelete.Enabled = False
        Else
            cmdSave.Enabled = True
            cmdDelete.Enabled = True
        End If
        cmdNew.Enabled = True
        cmdClose.Caption = "Close"
        
       
    End If
    
    If Trim(txtCollectionNo.Text) = "" Then
        cmdSave.Enabled = False
        cmdDelete.Enabled = False
        Frame2.Enabled = False
        
    Else
        cmdSave.Enabled = True
        cmdDelete.Enabled = True
        Frame2.Enabled = True
        
    End If
End Sub


Private Sub cmdNew_Click()
   blnNew = True
    txtCollectionNo.Text = ""
    txtCustomerName.Text = ""
    txtContact.Text = ""
    txtIMEI.Text = ""
    txtPhonemodel.Text = ""
    txtProblem.Text = ""
    txtCondition.Text = ""
    txtCost.Text = ""
    txtDate.Text = Format(Now(), "dd-MMM-yyyy")
    
    cmdClose.Caption = "Cancel"
    cmdNew.Enabled = False
    cmdDelete.Enabled = False
    cmdSave.Enabled = True
    Frame2.Enabled = True
End Sub


Private Sub cmdSave_Click()
    If Trim(txtCollectionNo.Text) = "" Then
        MsgBox "Enter CollectionNo.", vbCritical, "Save"
        txtCollectionNo.SetFocus
        Exit Sub
    End If
    Call prSave
    cmdClose.Caption = "Close"
    cmdNew.Enabled = True
    ThisWorkbook.Save
    
End Sub
Private Sub prSave()
     ''''' Save the Data
    If blnNew = True Then
        TRows = Worksheets("Data").Range("A1").CurrentRegion.Rows.Count
        With Worksheets("Data").Range("A1")
            .Offset(TRows, 0).Value = txtCollectionNo.Text
            .Offset(TRows, 1).Value = txtCustomerName.Text
            .Offset(TRows, 2).Value = txtContact.Text
            .Offset(TRows, 3).Value = txtIMEI.Text
            .Offset(TRows, 4).Value = txtPhonemodel.Text
            .Offset(TRows, 5).Value = txtProblem.Text
            .Offset(TRows, 6).Value = txtCondition.Text
            .Offset(TRows, 7).Value = txtCost.Text
            
            If CheckBox1.Value = True Then    '''' Battery
                .Offset(TRows, 8).Value = "Yes"
            Else
                .Offset(TRows, 8).Value = "No"
            End If
            
            If CheckBox2.Value = True Then    '''' Sim
                .Offset(TRows, 9).Value = "Yes"
            Else
                .Offset(TRows, 9).Value = "No"
            End If
            If CheckBox3.Value = True Then    '''' MMC
                .Offset(TRows, 10).Value = "Yes"
            Else
                .Offset(TRows, 10).Value = "No"
            End If
            .Offset(TRows, 11).Value = txtStatus.Text
            .Offset(TRows, 12).Value = txtSPRUsed.Text
            .Offset(TRows, 13).Value = txtCharge.Text
            .Offset(TRows, 14).Value = txtDate.Text
            
            MsgBox "Data Saved", vbInformation, "Save"
            
         End With
        txtCollectionNo.Text = ""
        txtCustomerName.Text = ""
        txtContact.Text = ""
        txtIMEI.Text = ""
        txtPhonemodel.Text = ""
        txtProblem.Text = ""
        txtCondition.Text = ""
        txtCost.Text = ""
        CheckBox1.Value = 0
        CheckBox2.Value = 0
        CheckBox3.Value = 0
        txtStatus.Text = ""
        txtSPRUsed.Text = ""
        txtCharge.Text = ""
        txtDate.Text = ""
        Call prComboBoxFill
     Else
        For i = 2 To TRows
            If Trim(Worksheets("Data").Cells(i, 1).Value) = Trim(txtCollectionNo.Text) Then
                Worksheets("Data").Cells(i, 1).Value = txtCollectionNo.Text
                Worksheets("Data").Cells(i, 2).Value = txtCustomerName.Text
                Worksheets("Data").Cells(i, 3).Value = txtContact.Text
                Worksheets("Data").Cells(i, 4).Value = txtIMEI.Text
                Worksheets("Data").Cells(i, 5).Value = txtPhonemodel.Text
                Worksheets("Data").Cells(i, 6).Value = txtProblem.Text
                Worksheets("Data").Cells(i, 7).Value = txtCondition.Text
                Worksheets("Data").Cells(i, 8).Value = txtCost.Text
                
                 If CheckBox1.Value = True Then    '''' Battery
                    Worksheets("Data").Cells(i, 9).Value = "Yes"
                Else
                    Worksheets("Data").Cells(i, 9).Value = "No"
                End If
            
                If CheckBox2.Value = True Then    '''' Sim
                    Worksheets("Data").Cells(i, 10).Value = "Yes"
                Else
                    Worksheets("Data").Cells(i, 10).Value = "No"
                End If
                If CheckBox3.Value = True Then    '''' MMC
                    Worksheets("Data").Cells(i, 11).Value = "Yes"
                Else
                    Worksheets("Data").Cells(i, 11).Value = "No"
                End If
                Worksheets("Data").Cells(i, 12).Value = txtStatus.Text
                Worksheets("Data").Cells(i, 13).Value = txtSPRUsed.Text
                Worksheets("Data").Cells(i, 14).Value = txtCharge.Text
                Worksheets("Data").Cells(i, 15).Value = txtDate.Text
                
                MsgBox "Data Saved", vbInformation, "Save"
                
                txtCollectionNo.Text = ""
                txtCustomerName.Text = ""
                txtContact.Text = ""
                txtIMEI.Text = ""
                txtPhonemodel.Text = ""
                txtProblem.Text = ""
                txtCondition.Text = ""
                txtCost.Text = ""
                CheckBox1.Value = 0
                CheckBox2.Value = 0
                CheckBox3.Value = 0
                txtStatus.Text = ""
                txtSPRUsed.Text = ""
                txtCharge.Text = ""
                txtDate.Text = ""
                Exit For
            End If
        Next i
      End If
    blnNew = False
    
    If Trim(txtCollectionNo.Text) = "" Then
        cmdSave.Enabled = False
        cmdDelete.Enabled = False
        Frame2.Enabled = False
    Else
        cmdSave.Enabled = True
        cmdDelete.Enabled = True
        Frame2.Enabled = True
    End If
End Sub


Private Sub cmdSearch_Click()
    Dim strText() As String
    blnNew = False
    txtCollectionNo.Text = ""
    txtCustomerName.Text = ""
    txtContact.Text = ""
    txtIMEI.Text = ""
    txtPhonemodel.Text = ""
    txtProblem.Text = ""
    txtCondition.Text = ""
    txtCost.Text = ""
    strText = Split(ComboBox1.Text, vbTab)
   TRows = Worksheets("Data").Range("A1").CurrentRegion.Rows.Count
   For i = 2 To TRows
      If Trim(Worksheets("Data").Cells(i, 1).Value) = Trim(strText(0)) Then


              txtCollectionNo.Text = Worksheets("Data").Cells(i, 1).Value
              txtCustomerName.Text = Worksheets("Data").Cells(i, 2).Value
              txtContact.Text = Worksheets("Data").Cells(i, 3).Value
              txtIMEI.Text = Worksheets("Data").Cells(i, 4).Value
              txtPhonemodel.Text = Worksheets("Data").Cells(i, 5).Value
              txtProblem.Text = Worksheets("Data").Cells(i, 6).Value
              txtCondition.Text = Worksheets("Data").Cells(i, 7).Value
              txtCost.Text = Worksheets("Data").Cells(i, 8).Value
              
              If Trim(Worksheets("Data").Cells(i, 9).Value) = "Yes" Then
                CheckBox1.Value = 1
              Else
                CheckBox1.Value = 0
              End If
              If Trim(Worksheets("Data").Cells(i, 10).Value) = "Yes" Then
                CheckBox2.Value = 1
              Else
                CheckBox2.Value = 0
              End If
              If Trim(Worksheets("Data").Cells(i, 11).Value) = "Yes" Then
                CheckBox3.Value = 1
              Else
                CheckBox3.Value = 0
              End If
              txtStatus.Text = Worksheets("Data").Cells(i, 12).Value
              txtSPRUsed.Text = Worksheets("Data").Cells(i, 13).Value
              txtCharge.Text = Worksheets("Data").Cells(i, 14).Value
              txtDate.Text = Format(Worksheets("Data").Cells(i, 15).Value, "dd-MMM-yyyy")
              
            Exit For
        End If
    Next i
    If Trim(txtCollectionNo.Text) = "" Then
        cmdSave.Enabled = False
        cmdDelete.Enabled = False
        Frame2.Enabled = False
    Else
        cmdSave.Enabled = True
        cmdDelete.Enabled = True
        Frame2.Enabled = True
    End If
End Sub


Private Sub prComboBoxFill()
       TRows = Worksheets("Data").Range("A1").CurrentRegion.Rows.Count
       ComboBox1.Clear
       For i = 2 To TRows
               ComboBox1.AddItem Worksheets("Data").Cells(i, 1).Value & vbTab & Worksheets("Data").Cells(i, 2).Value
    Next i
End Sub






Private Sub txtDate_AfterUpdate()
    If IsDate(txtDate.Text) = False Then
        MsgBox "Invalid Date", vbCritical, "Emp Details"
        txtDate.SetFocus
    End If
End Sub


Private Sub txtDate_Change()
    
End Sub






Private Sub txtDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If IsDate(txtDate.Text) = False Then
        MsgBox "Invalid Date", vbCritical, "Emp Details"
        txtDate.SetFocus
    End If
End Sub


Private Sub UserForm_Initialize()
    Call RemoveCaption(Me)
    Application.Visible = False
    Call prComboBoxFill
    cmdSave.Enabled = False
    cmdDelete.Enabled = False
    Frame2.Enabled = False
End Sub


'
'~~> Rest of the code
'


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    ThisWorkbook.Close SaveChanges:=True '<~~ Save workbook before closing
    DoEvents
    Application.Visible = True
End Sub
 
Last edited by a moderator:

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Sort by date Sort by votes
Your question leaves a lot of room for interpretation, and I figure you didn't write all that code because of that. Sure it's possible to convert, but you would have to build the supporting tables, forms and queries first. Since there is no real correlation between what seems to be going on in that spreadsheet and what goes on in a table (e.g. you don't wipe out table data on a regular basis only to replace it with something else) one would have to know the details of the business process at hand. What you seem to be asking for is no small task for a forum.
 
Upvote 0
You must log in or register to reply here.

Similar threads

tjdrake
  • Solved
Multi-User Access DB Table
Replies
3
Views
1K
Micron
M
R
  • Solved
Late Binding: extract Access to Excel with formatting
2 3
Replies
22
Views
4K
roelandwatteeuw
R
J
  • Solved
VBA Code Not Closing Excel Application
2
Replies
12
Views
4K
JohanGduToit
J
T
  • Solved
Help with VBA Code in Excel
Replies
2
Views
171
tixarah
T
V
  • Question
VBA excel worksheet2 out of range even though the cell is within the range and additional value created
Replies
4
Views
186
MARK858
MARK858

Forum statistics

Threads
1,221,814
Messages
6,162,135
Members
451,743
Latest member
matt3388

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