Details:
In this segment, I am filling the cell referenced by 'z' with modified date values from cell referenced by 'a', depending on the conditions met. The code crashes at the inner End If line.
Code snippet:
If Range(x).Value =1 Then
If Day(Range(a)) > Day(Range(b)) Then
Range(z).Value = DateSerial(Year(Range(a)), Month(Range(a)), Day(Range(a)-1)) + TimeSerial(20,0,0)
Else
Range(z).Value = DateSerial(Year(Range(a)), Month(Range(a)), Day(Range(a))) + TimeSerial(20,0,0)
End If
ElseIf Range(y).Value =1 Then
Range(z).Value = DateSerial(Year(Range(a)), Month(Range(a)), Day(Range(a)-1)) + TimeSerial(8,0,0)
Else
Range(z).Value = Range(a).Value
End If
Your code is good. Either you have a problem where one of your ranges is pointing to invalid data, or you have corruption in your module.
You can handle corruption by exporting your moodules to a text file (right click module in VBA editor->export) and then import into a clean workbook.
It seems to test fine for me.
I know default properties have been created in order to make code more concise, and I realize objects should not need to be fully qualified with their parent objects but I don't always trust the VBA compiler so my version is a little longer than yours (I've used the cells C1 to C5 to test):
Option Explicit
Sub FullyQualified()
With Excel.ThisWorkbook.Sheets("Sheet1")
If .Range("C1").Value = 1 Then
If Day(.Range("C3").Value) > Day(.Range("C4").Value) Then
.Range("C5").Value = DateSerial(Year(.Range("C3").Value), Month(.Range("C3").Value), Day(.Range("C3").Value - 1)) + TimeSerial(20, 0, 0)
Else
.Range("C5").Value = DateSerial(Year(.Range("C3").Value), Month(.Range("C3").Value), Day(.Range("C3").Value)) + TimeSerial(20, 0, 0)
End If
ElseIf .Range("C2").Value = 1 Then
.Range("C5").Value = DateSerial(Year(.Range("C3").Value), Month(.Range("C3").Value), Day(.Range("C3").Value - 1)) + TimeSerial(8, 0, 0)
Else
.Range("C5").Value = .Range("C3").Value
End If
End With
End Sub
Related
I need some help with vba code. I'm self-lerning so please be understanding for simply cases ;)
I'm trying to create macro which will be looking for some records/cells in one workbook (FileA) (determined by 3 conditions) and then paste values to another workbook (FileB) and after that find in another tab in FileB some values where condition will be pasted value to match them with looking value (I belivie it could be done somehow with Vlookup but I get stuck).
Below problematic for me part of code (I'm working on some files found in work, no one use it now).
First issue is with Set Update, I don't know why it takes it as "Nothing"... conditions are true - I mean "pp1" is existing in column A in FileA.
Second issue shows when I change i start range to some "later" numbers, eg From i = 2280, macro is ignoring last line where should assign some values (again shows update2 as "nothing") but value if pp2 is existing in W column in tab data...
Dim name As String
name = "[path to file on sharepoint]"
Application.ScreenUpdating = False
Workbooks.Open Filename:=name
a = 1
For i = 2263 To 14000
If Workbooks("FileA").Sheets("Main").Cells(i, 11) = "CANCEL" And Workbooks("FileA").Sheets("Main").Cells(i, 6) = "DENIS" And Workbooks("FileA").Sheets("Main").Cells(i, 5) > 1301358454 Then
pp1 = Workbooks("FileA").Sheets("Main").Cells(i, 1)
If pp1 > 0 Then
Set Update = Workbooks("FileA").Worksheets("Main").Range("A:A").Find(pp1, lookat:=xlPart)
If Update > 0 Then
Update = Update.Row
Workbooks("FileB").Worksheets("lost").Cells(a, 1).Value = Workbooks("FileA").Worksheets("Main").Cells(Update, 5)
pp2 = Workbooks("FileB").Worksheets("lost").Cells(a, 1)
update2 = Workbooks("FileB").Worksheets("data").Range("W:W").Find(pp2, lookat:=xlPart).Row
Workbooks("FileB").Worksheets("lost").Cells(a, 5) = Workbooks("FileB").Worksheets("data").Cells(update2, 43)
I have a sigle column ComboBox that I have populated with a dynamic array; however, I'd like the code to replace the value of the combo box with respective column from my ListBox.
'Prepares the Active Escorts list box.
ivb = 0
i = 0
With frmEntry
.listboxActiveEscorts.Clear
.listboxActiveEscorts.ColumnHeads = False
.listboxActiveEscorts.ColumnCount = "15"
.listboxActiveEscorts.ColumnWidths = "0,100,100,0,0,100,100,0,0,0,0,0,100,100,80"
i = 0
'Badge # combobox properties
ReDim vbArray(0 To vbArrayCount - 1)
For i = 0 To vbArrayCount - 1
ivb = ivb + 1
vbArray(ivb - 1) = loVisBadge.Range.Cells(i + 2, 1).Value
Next i
.cbxVisitorBadgeNumber.List = vbArray
End With
This population of the ComboBox executes beautifully, in my belief, but if you see a better way to implement the dynamic list, I'm all ears.
I have a button that I will use to reset the form, which also works for the most part. When an item is selected from the list, I am able to clear all controls except for the ComboxBox containing the array of values. I will be adding two additional arrays to each of the other ComboBoxes on the form, and I imagine I am going to have the same problem: "Could not set the value property. Invalid property value"
This is the code assigned to click event of the ListBox:
Private Sub listboxActiveEscorts_Click()
With frmEntry
.cbxEscortSelectName.Value = .listboxActiveEscorts.Column(1) + " " + .listboxActiveEscorts.Column(2)
.txtCredential.Value = .listboxActiveEscorts.Column(4)
.txtEscortCompany.Value = .listboxActiveEscorts.Column(3)
.cbxVisitorName.Value = .listboxActiveEscorts.Column(5) + " " + .listboxActiveEscorts.Column(6)
.txtVECompany.Value = .listboxActiveEscorts.Column(7)
.txtVEDOB.Value = .listboxActiveEscorts.Column(8)
.txtVEIdentification.Value = .listboxActiveEscorts.Column(9)
.txtVEIDNumber.Value = .listboxActiveEscorts.Column(10)
.txtVEExpirationDate.Value = .listboxActiveEscorts.Column(11)
.txtVEStart.Value = .listboxActiveEscorts.Column(12)
.txtVEEnd.Value = .listboxActiveEscorts.Column(13)
'.cbxVisitorBadgeNumber.Value = ""
.cbxVisitorBadgeNumber = vbNullString
.cbxVisitorBadgeNumber.Value = .listboxActiveEscorts.Column(14)
End With
End Sub
What am I missing here. I tried to ReDim the array that assigned the values, but that didn't work. Is it a data type thing, perhaps?
In the picture below, you'll see the values populated in the controls, all except the visitor badge # (ComboBox which throws the error...I have commented out the line for illustration purposes, so you'll see the visitor badge # is blank).
I have a Microsoft Form 2.0 Frame Control with three option buttons. The name of the Frame Control is Side, three option button captions are X, O, and Random with names xOption, oOption, and randomSide respectively.
The code runs fine, except upon startup, if I open Excel and run the program immediately, it will give me an Error 91, note that one of the options (X, O, or Random) is already selected. In order to get rid of this error, I need to explicitly select another option, then the error goes away. I don't know why this happens. Here is the sub for the Frame Control
Public Sub Side_Click()
sideLetter = Side.ActiveControl.Caption
If StrComp(sideLetter, "Random") = 0 Then
Randomize
tempRand = Int((Rnd() * 2 + 1))
If tempRand = 1 Then
sideLetter = "X"
Else
sideLetter = "O"
End If
End If
End Sub
The Line sideLetter = Side.ActiveControl.Caption Is the one causing the issue. I have not explicitly declared Side as a frame control in case that's some helpful information because I'm thinking that the object is already declared just by making the Frame Control. Thanks in advance!
You need to check that Side.ActiveControl is actually an object, before you read it's Caption:
Public Sub Side_Click()
If Not Side.ActiveControl Is Nothing Then
sideLetter = Side.ActiveControl.Caption
If StrComp(sideLetter, "Random") = 0 Then
Randomize
tempRand = Int((Rnd() * 2 + 1))
If tempRand = 1 Then
sideLetter = "X"
Else
sideLetter = "O"
End If
End If
End If
End Sub
I am trying to build an organization chart automatically from data in Excel using Excel VBA. It works out fine, however, I would like to have both textframes filled in. In the big textframe I would like to have filled in the description of the department, and in the smaller textframe I would have like to add the department code.
smartart hierarchy layout
I can't find the code to access the smaller textframe.
Do While Source.Cells(Line, 1) <> ""
If Source.Cells(Line, 3) = PID Then
Set ParNode = QNode
If Source.Cells(Line, 4) = 1 Then
Set QNode = QNode.AddNode(msoSmartArtNodeDefault, msoSmartArtNodeTypeAssistant)
Else: Set QNode = QNode.AddNode(msoSmartArtNodeBelow)
End If
QNode.TextFrame2.TextRange.Text = Cells(Line, 6)
'here something needs to be added !!!
CurPid = Source.Cells(Line, 2)
If Not Found Then Found = True 'something was find
'Source.Rows(Line).Delete
'Line = Line + 1
Call AddChildNodes(QNode, Source, CurPid)
Debug.Print ("CurPid" & CurPid)
Debug.Print ("line" & Line)
Set QNode = ParNode
'ElseIf Found Then 'it's sorted,so nothing else can be found
' Exit Do
'Else
End If
Line = Line + 1
Loop
the upper line (where your CEO-text is)
QNode.TextFrame2.TextRange.Text
***.SmartArt.AllNodes(...).Shapes(1).TextFrame2.TextRange.Text
the lower line where your smartart is empty:
***.SmartArt.AllNodes(...).Shapes(2).TextFrame2.TextRange.Text
you need to check if QNode.Shapes(2).TextFrame2.TextRange.Text works. if not, you may need to use .parent
I am using an inputbox the get a number from a user. I want to avoid not allowed input and am stuck with negative numbers. The only input which should be processed is an integer between 1 and 500. I don't understand why -1 is still triggered. Here is my code so far:
LBefore = InputBox("lines?", "", ">>> insert number <<<", 11660, 9540)
Select Case StrPtr(LBefore)
Case 0
'Cancel pressed
Exit Sub
Case Else
If (LBefore <> "") Then
'Check for numeretical value
If IsNumeric(LBefore) Then
cijfer = Abs(CByte(LBefore))
'Check to see if value is in allowed range
If (cijfer >= 1) And (cijfer <= 500) Then
'do stuff ...
end If
End If
End If
End Select
It's triggered because you use cijfer = Abs(CByte(LBefore)).
Abs is absolute function, so negative numbers become positive!
Try using cijfer = CInt(LBefore).