I am doing a quick game in Excel VBA, in a userform and a button should use a value from a cell that I input with variable but everytime I got the error 1004.
The weird thing is that when I put a normal number instead of the second variable. the error doesn't appear.
Private Sub CommandButton13_Click()
Dim types(2 To 19, 2 To 19, 2 To 19, 2 To 19), ataques(2 To 19, 2 To 19, 2 To 19) As Double
Dim tipo12, tipo21, tipo22, ataque11, ataque12, ataque13, ataque14, ataque21, ataque22, taque23, ataque24 As Integer
Dim tipo11 As Integer
Dim ataq1a2 As Integer
tipo11 = Label19.Caption
tipo12 = Label20.Caption
tipo21 = Label21.Caption
tipo22 = Label22.Caption
ataque11 = Label23.Caption
ataque12 = Label24.Caption
ataque13 = Label25.Caption
ataque14 = Label26.Caption
ataque21 = Label27.Caption
ataque22 = Label28.Caption
ataque23 = Label29.Caption
ataque24 = Label30.Caption
MsgBox tipo21
'MsgBox Worksheets("Hoja1").Cells(2, 2).Value
MsgBox Worksheets("Hoja1").Cells(tipo11, tipo21).Value
End Sub`
Related
I have a programmatically designed Excel userform running modaly.
It sometimes crashes and when It does, I will have to start inputting data all over again.
I found a way of saving this volatile data on a worksheet from where I can recover them in case of crash so that I won't need to input them all over again. The problem is that when the TextBoxes are programmaticaly filled, the corresponding AfterUpdate Events do not run.
I have written codes to make them run but I get error that the macro does not exist. I even wrote separate non-Private Subroutines that should do the same thing the AfterUpdate does, but I still get the same error.
Here is the code that recovers data.
Private Sub Retrieve_Values()
Dim c, S_Row, E_Row, R_Count As Long, Tname, Vname As String
S_Row = 2
With TempWs
If Not IsEmpty(.Cells(S_Row, 1)) Then
If Not IsEmpty(.Cells(S_Row + 1, 1)) Then
R_Count = .Range(.Cells(S_Row, 1), .Cells(S_Row, 1).End(xlDown)).Rows.Count
Else
R_Count = 1
End If
E_Row = S_Row + R_Count - 1
For c = S_Row to E_Row
Tname = .Cells(c, 1).Value
Me.Controls(Tname) = .Cells(c, 2).Value
Vname = Tname
Tname = "Help_" & Tname
Run Tname Vname
Next
End If
End With
Below is a sample of code it should run
Sub Help_BIODATA_DATE_OVERRIDE_TextBox(ByVal Vname As String)
Dim MyValue As String
MyValue = Me.Controls(Vname).Value
If Not MyValue = "" Then
OV_Date = Extract_Date(MyValue)
Real_Date = OV_Date
Client_Dict("DATE OVERRIDE") = OV_Date
Else
Real_Date = DATE
Client_Dict("DATE OVERRIDE") = ""
End If
Me.Date_Label.Caption = Date_Display(Real_Date)
Age = Calculate_Age(Real_Date, D_O_B)
Me.Age_Label.Caption = Age
Day_Cash_Collections
Attendace_Register
Account_Summary
All codes are in the userform codemodule
I am creating a spreadsheet for a client to manage his ALM. I developped it under Excel and VBA, request of my client.
One sheet "Data" calculates all the vba functions. If i calculate manually each cell all works fine, but if i run the macro it did not.
Do you have a solution? I can post the entire file if needed, for a better investigation.
At the beginning all the calculation where in excel cell, but i created dedicated function for each table, because the file was too big when saved.
Public Sub Main()
Dim i, nb_tableaux As Integer
Dim j, lignemax, BarWidth As Long
Dim ProgressPercentage As Double
Dim echeancier, nomtableau As String
Dim ws_data As Worksheet
Dim c As Range
Me.ProgressLabel.Caption = "Initialisation terminée. "
Set ws_data = Sheets("Data")
lignemax = ws_data.Range("DATA").Rows.Count
Application.ScreenUpdating = True
Application.EnableEvents = True
nb_tableaux = 17
For i = 1 To nb_tableaux
echeancier = tab_Tableaux(i, 0)
nomtableau = tab_Tableaux(i, 1)
Me.ProgressLabel.Caption = "En cours : " & echeancier
ws_data.Range(nomtableau).Calculate
'With Worksheets("Data")
For j = 1 To lignemax
For Each c In ws_data.Range(nomtableau).Rows(j)
formulaToCopy = c.Formula
c.ClearContents
c.Value = formulaToCopy
DoEvents
Next
Me.ProgressLabel.Caption = "En cours : " & echeancier & ", " & Format(j / lignemax, "0.0%") & " completed"
Me.Repaint
Next j
'End With
Me.Bar.Width = i * 200 / nb_tableaux
Me.Bar.Caption = Format(i / nb_tableaux, "0%") & " completed"
Next i
Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub
after taking into account the recommandations you gave me for my previous answers, the code works better, but still not for some of the ranges.
My issue come from a wrong calculation of a argument in the fonction.
In fact, I use ligne=activecell.row - 8, to get the ligne of the range to calculate. But it works if i do it manually, as the actual cell is activated, but not when i call the function many times, as i can not activate each cell, it will be too long for the spreadsheet.
How can i get ligne calculated, with the correct address of the cell where the function is written?
I hope i am clear enough. Sorry for my English.
Public Function Taux_Mois(ByVal mMois As Range, ByVal sScenario As Range)
Dim ligne As Long
ligne = ActiveCell.row - 8
Select Case (Range("DATA[Flag]").Cells(ligne).Value = 0) Or (Range("DATA[frequence fixing]").Cells(ligne).Value = 0)
Case True
Taux_Mois = 0
Exit Function
Case False
Dim index_taux As Integer
Dim ajust As Long
index_taux = CInt(Range("DATA[Indexation ID]").Cells(ligne).Value)
If index_taux = 1 Then
ajust = 0
Else
Dim ajust1, dernierfixingt0, freqfixing As Integer
dernierfixingt0 = Range("DATA[Dernier fixing t0]").Cells(ligne).Value
freqfixing = Range("DATA[frequence fixing]").Cells(ligne).Value
ajust1 = (Int((mMois.Value - dernierfixingt0) / freqfixing) * freqfixing)
ajust = Worksheets("Market Data").Range("Taux_" & sScenario.Value).Offset(12 + dernierfixingt0 + ajust1, 1 + index_taux).Value
End If
Taux_Mois = Range("DATA[facteur taux (TVA, base)]").Cells(ligne).Value * (ajust + Range("DATA[Spread / Taux]").Cells(ligne).Value / 10000)
Exit Function
End Select
End Function
I'm using a form to populate a sheet in Excel. In the form, the date-related boxes are broken up by day-month-year combo boxes, which are concatenated to populate a single cell in the sheet. My question is whether there is a way to "unconcatenate" a date in a single cell and populate each individual combo box with the appropriate information (day, month, or year). This is because I want to be able to add new information in one form, then update what already exists in the table in another form.
Code to update form based on given parameter below (focus in Bold):
Private Sub txtstudynm_Change()
Dim StudyName As String
Dim WrdString As String
Dim text_string As String
If Me.txtstudynm.Value = "" Then
MsgBox "Study Name can not be blank", vbCritical
Exit Sub
End If
StudyName = txtstudynm.Value
On Error Resume Next
Me.cmbprojman.Value = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 2, 0)
On Error Resume Next
Me.cmbstudtyp.Value = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 3, 0)
On Error Resume Next
Me.cmbprogtyp.Value = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 4, 0)
On Error Resume Next
Me.cmbfundtyp.Value = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 5, 0)
On Error Resume Next
Me.txtbudget.Value = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 6, 0)
On Error Resume Next
Me.txtencumb.Value = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 7, 0)
On Error Resume Next
Me.cmbpath.Value = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 8, 0)
**On Error Resume Next**
**text_string = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 9, 0).Value**
**WrdString = Split(text_string, "/")(0)**
**Me.tssdcmb1.Value = WrdString**
On Error Resume Next
Me.tssdcmb2.Value = WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 9, 0)
On Error Resume Next
Me.tssdcmb3.Value = WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 9, 0)
End Sub
Instead of all those references to the worksheet, use a Variant array:
Private Sub txtstudynm_Change()
If Me.txtstudynm.Value = "" Then
MsgBox "Study Name can not be blank", vbCritical
Exit Sub
End If
Dim StudyName As String
StudyName = txtstudynm.Value
Dim lkp As Variant
lkp = Sheets("Study Summary").Range("A3:AJ3000").Value2
Dim i As Long
For i = 1 To UBound(lkp, 1)
If lkp(i, 1) = StudyName Then
Me.cmbprojman.Value = lkp(i, 2)
Me.cmbstudtyp.Value = lkp(i, 3)
Me.cmbprogtyp.Value = lkp(i, 4)
Me.cmbfundtyp.Value = lkp(i, 5)
Me.txtbudget.Value = lkp(i, 6)
Me.txtencumb.Value = lkp(i, 7)
Me.cmbpath.Value = lkp(i, 8)
Me.tssdcmb1.Value = Day(lkp(i, 9))
Me.tssdcmb2.Value = Month(lkp(i, 9))
Me.tssdcmb3.Value = Year(lkp(i, 9))
Exit For
End If
Next i
End Sub
Try this (not sure which Combo Box you set to Day/Month/Year)...
Dim StudyDate as Date
If IsDate(text_string) Then
StudyDate = CDate(txt)
Me.tssdcmb1.Value Day(StudyDate)
Me.tssdcmb2.Value Month(StudyDate)
Me.tssdcmb3.Value Year(StudyDate)
End If
Declare text_string as a proper Date value (and this is why you don't encode a variable's data type in its name). Then the VLOOKUP will yield a Date value:
text_string = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 9, 0).Value
If what you have is a proper Date, then you use the VBA.DateTime.Year, VBA.DateTime.Month, and VBA.DateTime.Day functions to get each part:
Me.tssdcmb1.Value = Year(text_string)
Me.MonthBox.Value = Month(text_string)
Me.DayBox.Value = Day(text_string)
Notice how meaningful, pronounceable names make the code easier to read/follow.
If what you have is really a string that looks like a date, then... you better hope that the format is consistent, and then using the VBA.Strings.Split function like you did wasn't a bad idea - just use the 3 indices you got:
Dim dateParts As Variant
dateParts = Split(text_string, "/")
Me.YearBox.Value = dateParts(0)
Me.MonthBox.Value = dateParts(1)
Me.DayBox.Value = dateParts(2)
I have a format of labels in a word document as follows
<Name_Prod1>
<Curr_Cost1>
<Est_Cost1>
<Name_Prod11>
<Curr_Cost11>
<Est_Cost11>
<<Name_Prod12>
<Curr_Cost12>
<Est_Cost12>
<Name_Prod13>
<Curr_Cost13>
<Est_Cost13>
and so on...
My excel is of the format:
<S.NO> <Product name> <Current cost> <Est cost>
I want to go through the excel sheet and get the values and replace them in the caption of associated label.
My code is as follows. But I am not able to create a generic format to append the numbering to label name and loop through the label numbers.
Private Sub CommandButton1_Click()
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Set exWb = objExcel.Workbooks.Open("C:****.xlsx")
Dim i As Integer
Dim j As Integer: j = 1
'For the first set
ThisDocument.Name_Prod1.Caption = exWb.Sheets("Main Sheet").Cells(2, 2)
ThisDocument.Curr_Cost1.Caption = exWb.Sheets("Main Sheet").Cells(2, 3)
ThisDocument.Est_Cost1.Caption = exWb.Sheets("Main Sheet").Cells(2, 4)
'For the next set onwards
For i = 1 To i + 2 = 60
Dim ji As String
ji = j & i
'ji should be 11, 12, 13... as i increases
Dim np As Object: Set np = "Name_Prod" & ji
Dim cc As String: cc = "Curr_Cost" & ji
Dim ec As String: ec = "Est_Cost" & ji
ThisDocument.np.Caption = exWb.Sheets("Main Sheet").Cells(i + 2, 2)
ThisDocument.cc.Caption = exWb.Sheets("Main Sheet").Cells(i + 2, 3)
ThisDocument.ec.Caption = exWb.Sheets("Main Sheet").Cells(i + 2, 4)
Next
exWb.Close
Set exWb = Nothing
End Sub
Please help with some solutions
If you have the syntax correct and you can compile this line without error
ThisDocument.Name_Prod1.Caption = exWb.Sheets("Main Sheet").Cells(2, 2)
Then you should be able to reference the other labels using the same method.
Just insert the variables into bracketed values for ThisDocument
ThisDocument.np.Caption becomes ThisDocument(np).Caption
ThisDocument.cc.Caption becomes ThisDocument(cc).Caption
ThisDocument.ec.Caption becomes ThisDocument(ec).Caption
Always a good idea to start your module with Option Explicit - then when you use Debug | Compile you can report on the line that causes the error message and add the error message to your question. These are keys to writing a good question that has a chance of being answered.
I have done a "copy and paste" to a value after comparing the "road" number and the code number. If those two are matching, Excel VBA will copy and paste in a cell defined. I have created a loop to repeat it. But I discovered that up to 7000 my program was working properly, and when I replaced 7000 by 30000, Excel VBA displays
"Run-time error '13' Type mismatch "
after a certain time. I dont know why. Below is my program:
Private Sub assigment()
Dim road As Double
Dim code As Double
Dim i As Double
For i = 4 To 30000
For code = 2 To 22
For road = 4 To 65
If ActiveWorkbook.Sheets("assignment").Cells(i, 6)=ActiveWorkbook.Sheets("SSUSE").Cells(3, code) Then
If ActiveWorkbook.Sheets("assignment").Cells(i, 8) = ActiveWorkbook.Sheets("SSUSE").Cells(road, 1) Then
ActiveWorkbook.Sheets("SSUSE").Cells(road, code).Copy ActiveSheet.Paste Destination:=ActiveWorkbook.Sheets("assignment").Cells(i, 10)
End If
End If
Next
Next
Next
End Sub
Dim vSource as Variant, vCode as Variant, vRoad as Variant, vAssignment as Variant, vAddress as Variant
vSource = ActiveWorkbook.Sheets("assignment").Range("F4:F30000").Value
vCode = ActiveWorkbook.Sheets("SSUSE").Range("B3:V3").Value
vRoad = ActiveWorkbook.Sheets("SSUSE").Range("A4:A65").Value
vAddress = ActiveWorkbook.Sheets("SSUSE").Range("B4:V65").Value
vAssignment = ActiveWorkbook.Sheets("assignment").Range("H4:H30000").Value
For i = LBound(vSource,1) to UBound(vSource,1)
For code = LBound(vCode,2) to UBound(vCode,2)
For road = LBound(vRoad,1) to UBound(vRoad,1)
If (vSource(i,1) = vCode(1, code)) AND (vAssignment(i,1) = vRoad(road,1)) Then
ActiveWorkbook.Sheets("assignment").Cells(i+3, 10).Value = vAddress(Road,Code)
End If
Next
Next
Next