Vba Problem Function, Call from a newbie

G

Gowodka

New Member
Joined
Aug 24, 2011
Messages
20
Hi All,

What am i doing, i wrote a vba code that takes data from textboxes and Comboboxes and put this data in to 2 excel workbooks and makes a 3th one ( from a template ) puts in the data and save.

The data i get out of the textboxes are put into the different excel sheets.
Now i have 9 almost identical products with a few different textboxes. And i'm trying to simplify my code so it's cleaner. using functions.

As you can see in the code below, I want to make for example a function that puts the data of the textboxes in 1 excel sheet.

So for exapmle i could use: Function AddData( all the variables from the textboxes ). And this way i could reuse this function instead of copy pasting the whole code 9 times.

Or a function to check if the cell is filled with an numeric value. Now i copy pasted everything and changed the variable and the msgbox but if i could make a function that would look like this Function CheckNumeric( txtboxinput, "msgboxinfo As String") So i would just have to write
CheckNumeric(txtIncAenR, IncidentNummer)
CheckNumeric(txtDateAenR, Date)

Code: 
Private Sub cmdOkAenR_Click()
'----------------------
'Voegt datum, week en maand toe
'----------------------
Datum = Date
DatumMaand = Month(Datum)
DatumWeek = DatePart("ww", Datum, vbMonday, vbFirstFourDays)
DatumJaar = DatePart("YYYY", Datum, vbMonday, vbFirstFourDays)
'----------------------
'Kijkt de textboxes en Comboboxes na of de correcte data is ingevoerd
'----------------------
'Nummers
'----------------------
If Not IsNumeric(txtIncAenR) Then
MsgBox "Gelieve een getal in te geven bij IncidentNummer", vbExclamation, "Incidentnummer"
txtIncAenR.SetFocus
Exit Sub
End If
If Not IsNumeric(txtMateriaalNummerAenR) Then
MsgBox "Gelieve een getal in te geven bij Materiaal Nummer", vbExclamation, "Materiaal Nummer"
txtMateriaalNummerAenR.SetFocus
Exit Sub
End If
If Not IsNumeric(txtDateAenR) Then
MsgBox "Gelieve een getal in te geven bij Date", vbExclamation, "Date"
txtDateAenR.SetFocus
Exit Sub
End If
If Not IsNumeric(txtCAPAenR) Then
MsgBox "Gelieve een getal in te geven bij CAP", vbExclamation, "CAP"
txtCAPAenR.SetFocus
Exit Sub
End If
If Not IsNumeric(txtPositieAenR) Then
MsgBox "Gelieve een getal in te geven bij Positie", vbExclamation, "Positie"
txtPositieAenR.SetFocus
Exit Sub
End If
If Not IsNumeric(txtHoeveelheidAenR) Then
MsgBox "Gelieve een getal in te geven bij Hoeveelheid", vbExclamation, "Hoeveelheid"
txtHoeveelheidAenR.SetFocus
Exit Sub
End If
'----------------------
'Text
'----------------------
If txtProductAenR.Value = "" Then
MsgBox "Gelieve een product in te vullen", vbExclamation, "Product"
txtProductAenR.SetFocus
Exit Sub
End If
'----------------------
'Combobox
'----------------------
If cboAuteurAenR.Value = "" Then
MsgBox "Gelieve de correcte auteur te selecteren", vbExclamation, "Auteur"
Exit Sub
End If
If cboProbleemAenR.Value = "" Then
MsgBox "Gelieve een probleem te selecteren", vbExclamation, "Probleem"
Exit Sub
End If
'----------------------
'Controleert Mix of geen Mix en zorgt ervoor dat Vreemde gegevens kunnen bijgevoegd worden
'Maakt de string Gegevens waarin alle nodige data staan voor de info van het incidentenblad
'----------------------
If cboProbleemAenR = "Mix" Then
Gegevens = txtProductAenR.Value + ", " + txtMateriaalNummerAenR.Value + ", " + txtDateAenR.Value + ", " + txtCAPAenR.Value + ", " + txtPositieAenR.Value + " zat vreemd in pack" + txtVreemdProductAenR.Value + ", " + txtVreemdMateriaalNummerAenR.Value + ", " + txtVreemdDateAenR.Value + ", " + txtVreemdCAPAenR.Value + ", " + txtVreemdPositieAenR.Value
If Not IsNumeric(txtVreemdMateriaalNummerAenR) Then
MsgBox "Gelieve een getal in te geven bij Materiaal Nummer", vbExclamation, "Materiaal Nummer"
txtVreemdMateriaalNummerAenR.SetFocus
Exit Sub
End If
If Not IsNumeric(txtVreemdDateAenR) Then
MsgBox "Gelieve een getal in te geven bij Date", vbExclamation, "Date"
txtVreemdDateAenR.SetFocus
Exit Sub
End If
If Not IsNumeric(txtVreemdCAPAenR) Then
MsgBox "Gelieve een getal in te geven bij CAP", vbExclamation, "CAP"
txtVreemdCAPAenR.SetFocus
Exit Sub
End If
If Not IsNumeric(txtVreemdPositieAenR) Then
MsgBox "Gelieve een getal in te geven bij Positie", vbExclamation, "Positie"
txtVreemdPositieAenR.SetFocus
Exit Sub
End If
Else
Gegevens = txtProductAenR.Value + ", " + txtMateriaalNummerAenR.Value + ", " + txtDateAenR.Value + ", " + txtCAPAenR.Value + ", " + txtPositieAenR.Value
End If
'If txtVreemdProductAenR.Value = "" Then
'MsgBox "Gelieve een product in te vullen", vbExclamation, "Product"
'txtVreemdProductAenR.SetFocus
'Exit Sub
'End If
'------------------------
'Extra
'Workbooks("TestGroot.xlsm").Activate
Worksheets("sheet1").Activate
RowCount = Workbooks("Back UP 3.xlsm").Sheets("sheet1").Range("A1").CurrentRegion.Rows.Count
With Worksheets("sheet1").Range("A1")
    .Offset(RowCount, 6) = txtIncAenR
    .Offset(RowCount, 7) = Jaar
    .Offset(RowCount, 8) = DatumMaand
    .Offset(RowCount, 9) = DatumWeek
    .Offset(RowCount, 10) = Datum
    .Offset(RowCount, 11) = txtStartUur
    .Offset(RowCount, 12) = txtStartPloeg
    .Offset(RowCount, 13) = cboAuteurAenR
    .Offset(RowCount, 14) = txtStartOperatorInc
    .Offset(RowCount, 15) = txtStartOperatorVast
    .Offset(RowCount, 17) = txtMateriaalNummerAenR
    .Offset(RowCount, 18) = txtStartProduct
    .Offset(RowCount, 19) = "AenR"
    .Offset(RowCount, 23) = txtStartMinizone
    .Offset(RowCount, 24) = txtStartLijn
    .Offset(RowCount, 25) = "Packaging error"
    .Offset(RowCount, 27) = choProbleemAenR
    .Offset(RowCount, 28) = Gegevens
    .Offset(RowCount, 29) = txtStartOorzaak
    .Offset(RowCount, 30) = txtStartActies
ActiveWorkbook.Save
End With
'Einde Extra
'-------------------------
'----------------------
'Zoekt de volgende volledig lege lijn
Workbooks.Open ("R:\08 Pack\Student\Automatisatie\Compleetfinito.xlsm")
RowCount = Workbooks("Compleetfinito.xlsm").Sheets("Incidenten").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Incidenten").Range("A1")
    .Offset(RowCount, 0) = Datum
    .Offset(RowCount, 1) = DatumMaand
    .Offset(RowCount, 2) = DatumWeek
    .Offset(RowCount, 3) = txtIncAenR.Value
    .Offset(RowCount, 4) = cboAuteurAenR.Value
    .Offset(RowCount, 5) = "Pu"
    .Offset(RowCount, 6) = "AenR"
    .Offset(RowCount, 8) = cboProbleemAenR.Value
    .Offset(RowCount, 7) = txtMateriaalNummerAenR.Value
    .Offset(RowCount, 9) = txtHoeveelheidAenR.Value
    .Offset(RowCount, 10) = "stuks"
    .Offset(RowCount, 11) = txtOpmerkingenAenR.Value
    .Offset(RowCount, 12) = Gegevens
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
 
'----------------------
'Opent de template van Mead die zich op het onderstaande pad bevindt
'En voegt dan hierin de correcte data toe van dit incident
'----------------------
Workbooks.Open Filename:="O:\Industriële Directie\LaboUS\incidenten 2010\2011\Meldingen\Mead\Template_melding_mead_2011_ok.xls"
Workbooks("Template_melding_mead_2011_ok.xls").Sheets("sheet1").Range("I1").Value = txtIncAenR.Value
Workbooks("Template_melding_mead_2011_ok.xls").Sheets("sheet1").Range("I3").Value = txtMateriaalNummerAenR.Value
Workbooks("Template_melding_mead_2011_ok.xls").Sheets("sheet1").Range("E6").Value = cboProbleemAenR.Value
Workbooks("Template_melding_mead_2011_ok.xls").Sheets("sheet1").Range("B18").Value = txtHoeveelheidAenR.Value
Workbooks("Template_melding_mead_2011_ok.xls").Sheets("sheet1").Range("B8").Value = Gegevens
Workbooks("Template_melding_mead_2011_ok.xls").Sheets("sheet1").Range("I4").Value = Datum
Workbooks("Template_melding_mead_2011_ok.xls").Sheets("sheet1").Range("I2").Value = "AenR"
'----------------------
'Fname zorgt ervoor dat het correcte pad wordt gemaakt waar het incidentenblad wordt opgeslagen
'Hierna wordt de copy opgeslagen onder het pad van fname
'En dan Saven en wordt het gesloten
'----------------------
fname = "O:\Industriële Directie\LaboUS\incidenten 2010\2011\Meldingen\AenR\nog te versturen\" + "AenR Inc " + txtIncAenR.Value + ".xls"
Workbooks("Template_melding_mead_2011_ok.xls").SaveCopyAs fname
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub


I hope someone can help me

I use a few global variables as listed below

Code: 
Sub GlobalVariables()
    Dim RowCount As Long        'Telt de rijen
    Dim Datum As Date           'Datum
    Dim DatumMaand As Single    'MaandNummer
    Dim DatumWeek As Single     'WeekNummer
    Dim Gegevens As String      'gegevensstring waarin alle gegevens staan
    Dim fname As String         'naam van de file
    Dim DatumJaar As Single
    
End Sub

please help me
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
If some could just explain me how to use a function then i could probably find the rest.

I've been teaching myself VBA for the last week now
 
Upvote 0
One way:

Code: 
Sub demo()
    ' ...
    CheckNumeric UserForm1.TextBox1, "Textbox1 has to be numeric"
    ' ...
End Sub
 
Function CheckNumeric(ctl As Control, sMsg As String) As Boolean
    Select Case TypeName(ctl)
        Case "TextBox"
            If IsNumeric(ctl.Value) And Len(ctl.Value) > 0 Then
                CheckNumeric = True
            Else
                ctl.SetFocus
                MsgBox sMsg
            End If
        Case Else
            MsgBox "CheckNumeric: I only do textboxes!"
    End Select
End Function
 
Upvote 0
Ok :)

Thanks.

So i put the sub Demo en the Function all in the workbookcode ?

So then if i wan't to use this code to check if textbox with name txtProductionDate and textbox with name txtReeelNumber is filled in?

i just type

Code: 
sub ...click of button

CheckNumeric Incidenten.txtProductionDate, " Date has to be numeric" 
CheckNumeric Incidenten.txtReelNumber , " Reel Number has to be numeric"

Is this correct ?

Thank you a thousand times
 
Upvote 0
Now i have another question, i don't know if this is the place to ask it but it also has to do with the whole function things.

So i'm writing into some excel file
always on the next empty row ( using offset )

Could i make a function for this

Something like

Code: 
Function AddData( ... Here would be the textbox inputs ... )

And this should be the code that should be in the function
I work in sheet1 and the name of the workbook is Back UP 3.xlsm
I'm using textbox values ( start with txt ) Combobox Values ( starts with cbo )
and then some variables which are combinations of other textbox values.

Code: 
Worksheets("sheet1").Activate
RowCount = Workbooks("Back UP 3.xlsm").Sheets("sheet1").Range("A1").CurrentRegion.Rows.Count
With Worksheets("sheet1").Range("A1")
    .Offset(RowCount, 6) = txtIncAenR
    .Offset(RowCount, 7) = Jaar
    .Offset(RowCount, 8) = DatumMaand
    .Offset(RowCount, 9) = DatumWeek
    .Offset(RowCount, 10) = Datum
    .Offset(RowCount, 11) = txtStartUur
    .Offset(RowCount, 12) = txtStartPloeg
    .Offset(RowCount, 13) = cboAuteurAenR
    .Offset(RowCount, 14) = txtStartOperatorInc
    .Offset(RowCount, 15) = txtStartOperatorVast
    .Offset(RowCount, 17) = txtMateriaalNummerAenR
    .Offset(RowCount, 18) = txtStartProduct
    .Offset(RowCount, 19) = "AenR"
    .Offset(RowCount, 23) = txtStartMinizone
    .Offset(RowCount, 24) = txtStartLijn
    .Offset(RowCount, 25) = "Packaging error"
    .Offset(RowCount, 27) = choProbleemAenR
    .Offset(RowCount, 28) = Gegevens
    .Offset(RowCount, 29) = txtStartOorzaak
    .Offset(RowCount, 30) = txtStartActies
ActiveWorkbook.Save
End With


Then also I need a function to find the Year, Week, and Month out of a date, they should be all stored in YearNumber, WeekNumber and MonthNumber

This is what i got

Code: 
    Datum = Date
    MonthNumber= Month(Datum)
    WeekNumber= DatePart("ww", Datum, vbMonday, vbFirstFourDays)
    YearNumber= DatePart("YYYY", Datum, vbMonday, vbFirstFourDays)
 
Upvote 0
shg said:
One way:

Code: 
Sub demo()
    ' ...
    CheckNumeric UserForm1.TextBox1, "Textbox1 has to be numeric"
    ' ...
End Sub
 
Function CheckNumeric(ctl As Control, sMsg As String) As Boolean
    Select Case TypeName(ctl)
        Case "TextBox"
            If IsNumeric(ctl.Value) And Len(ctl.Value) > 0 Then
                CheckNumeric = True
            Else
                ctl.SetFocus
                MsgBox sMsg
            End If
        Case Else
            MsgBox "CheckNumeric: I only do textboxes!"
    End Select
End Function
Click to expand...

Thx for this code but still one problem, now if i run the code it indeed says that i didn't filled in the textbox but it doesn't stop the execution which should be done
 
Upvote 0
shg said:
One way:

Code: 
Sub demo()
    ' ...
    CheckNumeric UserForm1.TextBox1, "Textbox1 has to be numeric"
    ' ...
End Sub
 
Function CheckNumeric(ctl As Control, sMsg As String) As Boolean
    Select Case TypeName(ctl)
        Case "TextBox"
            If IsNumeric(ctl.Value) And Len(ctl.Value) > 0 Then
                CheckNumeric = True
            Else
                ctl.SetFocus
                MsgBox sMsg
            End If
        Case Else
            MsgBox "CheckNumeric: I only do textboxes!"
    End Select
End Function
Click to expand...

Thx for this code but still one problem, now if i run the code it indeed says that i didn't filled in the textbox but it doesn't stop the execution which should be done
 
Upvote 0
Gowodka said:
Thx for this code but still one problem, now if i run the code it indeed says that i didn't filled in the textbox but it doesn't stop the execution which should be done
Click to expand...

Never mind this i fixed it using the next code
Code: 
If( CheckNumeric(Incidenten.txtProduct, " Text " ) = False ) Then Exit Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

Emka
  • Question Question
Web Scrap on Chrome via VBA
Replies
0
Views
140
Emka
Emka
littlepete
  • Solved
inputbox arab name problem when father, not when mother or both
2 3
Replies
23
Views
1K
BSALV
BSALV
I
  • Solved
Automating Sheet name from value in Cell
Replies
5
Views
660
Joe4
Joe4
NessPJ
  • Question Question
VBS is selecting the wrong sheet?
Replies
7
Views
528
Fluff
Fluff
J
  • Question Question
Userform data validation not fully working in VBA
2
Replies
13
Views
2K
Fluff
Fluff

Forum statistics

Threads
1,224,586
Messages
6,179,726
Members
452,939
Latest member
WCrawford

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