I have a userform with textboxes txtTF1 – txtTF30 where odd numbers are a start date and even numbers are end dates. I’m using a calendar date picker and a (correctly functioning) logical test to help ensure the inputs are dates. I also want a logical test on the inputs to make sure I don’t have overlapping dates.
The code below correctly spots date overlap until it runs into textboxes that are intentionally left blank. Those blanks are set to vbnullstring when the form initializes. At this point something triggers the message box saying there is an overlap on the next to last set of dates even when I can see that is not true.
Debug.Print is showing that the last set of dates in the userform is not loading into the variables.
I’m not sure where/how this test breaks down. Any thoughts?
Sub OverlapCheck
Dim i as Long
Dim CheckDate1
Dim CheckDate2
Dim CheckDate3
For i = 2 To 28 Step 2
CheckDate1 = Controls("txtTF" & i).value
CheckDate2 = Controls("txtTF" & (i + 1)).value
CheckDate3 = Controls("txtTF" & (i - 1)).value
‘stop test if next date is blank
If Not IsDate(CheckDate2) Then Exit For
‘if a valid date range is entered then check to see if the next date is an overlap
If IsDate(CheckDate1) And IsDate(CheckDate3) Then
If CheckDate1 >= CheckDate2 Then
MsgBox ("Dates " & CheckDate1 & " and" & CheckDate2 & " overlap"), vbOKOnly
frmRLVL.Show
End If
End If
Next
End Sub
I got this to work with the addition of CDate() in the for/next statement. I'm still not sure why this makes it work on the last set of dates when input data ends where 2>i>28. At this point I'm calling it a win.
For i = 2 To 28 Step 2
CheckDate1 = Controls("txtTF" & i).value
CheckDate2 = Controls("txtTF" & (i - 1)).value
CheckDate3 = Controls("txtTF" & (i + 1)).value
If Not IsDate(CheckDate3) Then Exit For
If IsDate(CheckDate1) And IsDate(CheckDate2) Then
CheckDate1 = CDate(CheckDate1)
CheckDate2 = CDate(CheckDate2)
CheckDate3 = CDate(CheckDate3)
If CheckDate1 >= CheckDate3 Then
MsgBox ("Dates " & CheckDate1 & " and" & CheckDate3 & " overlap"), vbOKOnly
frmRLVL.Show
End If
End If
Next
Related
I have the bellow list, where I should add items in column B in each sheet ; liste_lameM1, liste_lameM2, liste_lameM3 et liste_lameM4:
enter image description here
I need to set a condition on the numbers of the column A, to add new item I need to specify the model from a combobox where i have 4 options( M1, M2, M3, M4) to choose the sheet where the item should be added (this part works well).
The second condition is to select a number from 001 to 300 from a combobox to be able to add my item in the correct place on column B, so if I choose 006, modele M1 my data should be in column B, line 7 in worksheet liste_lameM1, if I choose 007, modele M1 my data should be in column B line8 worksheet liste_lameM1, if I choose 010 , modele M2, my data is added on column B line 11 worksheet liste_lameM2 and so on.
here is my code:
Private Sub CommandButton1_Click()
Dim fin_liste As Range, ligne As Long, ws_lame As Worksheet, ctrl As Boolean
Set ws_lame = ActiveWorkbook.Worksheets("Liste_Lame_" & Me.ComboBox_Modele.Value)
Set fin_liste = ThisWorkbook.Worksheets("Liste_Lame_" & Me.ComboBox_Modele.Value).Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
For j = 2 To fin_liste
If ws_lame.Range("A" & j) = Me.ComboBox_Num.Value Then
ctrl = True
fin_liste = Me.ComboBox_Num.Value & "-" & Me.TextBox_Mois.Value & "-" & Me.TextBox_Annee.Value & "-" & Me.ComboBox_Modele.Value & "-" & Me.ComboBox_Const.Value
Exit For
End If
Next
If ctrl = False Then
j = fin_liste + 1
ws_lame.Range("A" & j).Value = Me.ComboBox_Num.Value
fin_liste = Me.ComboBox_Num.Value & "-" & Me.TextBox_Mois.Value & "-" & Me.TextBox_Annee.Value & "-" & Me.ComboBox_Modele.Value & "-" & Me.ComboBox_Const.Value
End If
End Sub
The problem with my code is that it is not respecting the numbers I am choosing, it just adds the items one after the other, what editing should I make ? thanks
Variable "j" for looping, I change to "ligne".
Based on your explanation, you can't make the second condition if you use this code as I give you before.
fin_liste = ThisWorkbook.Worksheets(combo.Value).Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
So even you choose number between 001 & 300, it still add the data exactly on the last row at column "B".
For example, if the last data on cell "B3" (B4 still empty) then you choose number 5 (you hope the data will add on "B6"), the data will add on "B4".
Then maybe you'll find that you can change the .offset(ComboBox_Num.Value, 0), but it will make your data in a mess.
So the code that I give you before ineffective for the 2nd condition.
Based on the 2nd condition, you can use this.
fin_liste = ThisWorkbook.Worksheets(combo.Value).Cells(ComboBox_Num.Value, "B").offset(1, 0)
I still write .offset(1, 0), because I think you want to add the first data on cell "B2", right?
Actually that code have a problem, but based on you question, I think that problem will not affect you. You'll find it out soon. (You should consider Zac's comment)
I've rewrite your code so I can try it on my excel easier. You can change it into your version.
Private Sub CommandButton1_Click()
Dim fin_liste As Range, ligne As Long, ws_lame As Worksheet, ctrl As Boolean
Set ws_lame = ActiveWorkbook.Worksheets(combo.value)
Set fin_liste = ThisWorkbook.Worksheets(combo.Value).Cells(combo2.Value, "B").Offset(1, 0) '.End(xlUp).Offset(combo2.Value, 0)
For ligne = 2 To fin_liste
If ws_lame.Range("A" & ligne) = combo2.Value Then
ctrl = True
fin_liste = text.Value
End If
Next
If ctrl = False Then
ligne = fin_liste + 1
ws_lame.Range("A" & ligne) = combo2.Value
fin_liste = text.Value
End If
End Sub
I am completely new in VBA or programming. Right now I am developing a macro for a manufacturing site that inputs process data using Excel's User Forms. One of the things I want this macro to do is to automatically create run numbers for each process. The run number syntax we use is as follows:
V1.yy.mm.dd-1
V1.yy.mm.dd-2
V1.yy.mm.dd-3
Ex V1.20.04.29-1
The way I am trying to set up the run number creation is that when I select an item from a ComboBox the part number gets created into a TextBox to later be submitted into the corresponding database. I am not sure how to create a sequence after the Prefix = V1.yy.mm.dd-, I tried to use a CountIf application that would count the number of Prefixes with the same date in the spreadsheet for sequencing, but it seems the function does not work for partial matches. I tried to use the following but I can't get it to work. I am sure there are simpler ways to do this, can you give me a few suggestions? Thanks
This is the code I wrote so far:
Private Sub ComboBox1_Change()
If Me.ComboBox1.Value <> "" Then
Dim Prefix As String
Dim mm, dd, yy As String
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("2- V1 Loading (2)")
Dim s As Long
s = 1 + sh.Application.Count(Application.Match(Prefix, Range("B:B"), 0))
mm = Format(Date, "mm")
dd = Format(Date, "dd")
yy = Format(Date, "yy")
Prefix = "V1." & yy & "." & mm & "." & dd & "-"
v1 = "V1." & yy & "." & mm & "." & dd & "-" & "" & s
Me.TextBox6.Value = v1
End If
Maybe something like this ?
Private Sub ComboBox1_Change()
If Me.ComboBox1.Value <> "" Then
Set sh = ThisWorkbook.Sheets("2- V1 Loading (2)")
oDate = Format(Date, "yy.mm.dd")
oConst = "V1." & oDate & "-"
Range("B1:B10000").Copy Destination:=Range("zz1") 'copy all the item to helper column
Range("zz:zz").Replace What:=oConst, Replacement:="" 'get only the number from all the items with the current date
nextNum = Application.Max(Range("zz:zz")) + 1 'get the next number
MsgBox oConst & CStr(nextNum) 'this line only for checking
Range("zz:zz").ClearContents 'clear the helper column
Me.TextBox6.Value = oConst & CStr(nextNum)
End If
But this assuming that the item number in columns B is only at the same day.
If for example there is a forgotten data from any day before the current day, and this want to be inputted with that day and the next number, it need an input box or maybe a cell in sheet where the value is that day, then it will give the last number of that day.
Suppose the data in column B is something like below:
If the code is run today, it will show V1.20.04.30-4 as the next number. With the same data like above, if the code is run tomorrow, it will give V1.20.05.01-1.
To get the next number from yesterday (29 Apr 2020), the code need more line - which is to know on what day the code must get the next number.
Or this kind of line maybe is shorter:
oConst = "V1." & Format(Date, "yy.mm.dd") & "-"
nextNum = oConst & Application.WorksheetFunction.CountIf(Range("B:B"), "*" & oConst & "*") + 1
MsgBox nextNum
There are a few ways you could go about this but I'd say the easiest would be to put the incrementing run number in a separate cell somewhere on your worksheet (or another one if you want) to reference each time.
For example:
When the data is entered onto your 'database' sheet, write the run value to ThisWorkbook.Sheets("2- V1 Loading (2)").Range("AZ1").
Then in your code check that value like so:
Private Sub ComboBox1_Change()
If Me.ComboBox1.Value <> "" Then
Dim Prefix As String
Dim mm, dd, yy As String
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("2- V1 Loading (2)")
Dim s As Long
s = 1 + sh.Range("AZ1").Value
mm = Format(Date, "mm")
dd = Format(Date, "dd")
yy = Format(Date, "yy")
Prefix = "V1." & yy & "." & mm & "." & dd & "-"
v1 = "V1." & yy & "." & mm & "." & dd & "-" & s
Me.TextBox6.Value = v1
Presuming that the reference numbers are written to column B of the 2- V1 Loading (2) tab then the next number must always be the one found at the bottom of the column + 1. If there is no number for that date than the new sequential number should be 1. The code below implements that method
Function NextRef() As String
' 016
Dim Fun As String
Dim Counter As Integer
Dim Rng As Range
Dim Fnd As Range
Dim Sp() As String
Fun = Format(Date, """V1.""yy.mm.dd")
With ThisWorkbook.Worksheets("2- V1 Loading (2)")
' start in row 2 (row 1 holding column captions)
Set Rng = .Range(.Cells(2, "B"), .Cells(.Rows.Count, "B").End(xlUp))
End With
If Rng.Row > 1 Then ' skip, if the column is empty
' finds the first occurrence of Ref from the bottom
Set Fnd = Rng.Find(What:=Fun, _
After:=Rng.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchDirection:=xlPrevious)
If Not Fnd Is Nothing Then
Sp = Split(Fnd.Value, "-")
If UBound(Sp) Then Counter = Val(Sp(1))
End If
End If
NextRef = Fun & -(Counter + 1)
End Function
You can use the function simply like ComboBox1.Value = NextRef. However when and how to call that line of code is a bit unclear in your design as published. Especially, it's not clear why you would want it in a ComboBox at all, given that the box might also contain other information. Your idea to use the Change event may not work as intended because that event occurs with every letter the user types. I have tested this:-
Private Sub ComboBox1_GotFocus()
' 016
With ComboBox1
If .Value = "" Then .Value = NextRef
End With
End Sub
The next reference number is inserted as soon as you click on the ComboBox. It works but it doesn't make sense. I think now that you have the function that does the work you will find a way to deploy it. Good luck.
So I am writing a case function that when an event (7 - Engaged) occurs an interactive textbox pops up asking the user to confirm this action. If they select OK the data is moved to another spreadsheet.
That all works dandy but probably needs revising to tidy it.
Anyways, the issue arises when the user selects cancel.
Instead of just leaving the function the line of data is deleted.
I believe this issue is the last couple lines deletes anything that is 7-engaged, but I haven't written a piece of code to bring the value down to 6 if the user cancels out.
Can anyone give me some hints?
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
' Maybe disable events whilst this code runs (and re-enable before exit)
' to prevent recursion.
' The three range rows are to move sepearate sections of data from pipeline into isolated blocks in tank.
If Source.Column <> 9 Then Exit Sub ' 9 = I
If Source.Cells.Count > 1 Then Exit Sub ' Check this first before making comparison on next line
If Source.Value <> "7 - engaged" Then Exit Sub
If MsgBox("Client status selected as engaged. Confirm to post to tank.", vbOKCancel) = vbOK Then
With ThisWorkbook.Worksheets("Tank") 'Produces an interactive dialoge box prompting the user to confirm they wish ti import to tank
'The code only fires if they confirm - if not, the line will remain in Pipeline.
Dim rowToPasteTo As Long
rowToPasteTo = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
.Range("A" & rowToPasteTo & ":" & "D" & rowToPasteTo).Value = Sh.Range("A" & Source.Row & ":" & "M" & Source.Row).Value
.Range("G" & rowToPasteTo & ":" & "H" & rowToPasteTo).Value = Sh.Range("E" & Source.Row & ":" & "F" & Source.Row).Value
.Range("S" & rowToPasteTo & ":" & "U" & rowToPasteTo).Value = Sh.Range("K" & Source.Row & ":" & "M" & Source.Row).Value
End With
End If
If Source.Column = 9 And Source.Value = "7 - engaged" Then
Source.EntireRow.Delete
' The above line deleted the row from pipeline once it has been imported in Tank
End If
End Sub
I have now added this piece of code which negates the problem.
If MsgBox("Client status selected as engaged. Confirm to post to tank.", vbOKCancel) = vbCancel Then
Source.Value = "6 - KYC in progress" ' If cancel is selected the value goes back to Case 6 and the line is kept.
End If
I'm working on a 'dashboard' in excel where the user can select a commodity and then presses the run button, so the code then prints out all suppliers linked to that commodity. (Several commodities and supplier names are listed on other tabs in the same workbook, and the code goes over all tabs to collect the right supplier names)
EDIT: the issue is due to a supplier name being longer than 255 characters.
The debugger focuses on this code in particular:
If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then
cell.Offset(0, 0).Font.Color = vbRed
End If
This code is part of the bigger set below. The code highlights all suppliernames that are listed under the chosen category in different tabs (hence they would be printed out multiple times, I want to highlight the duplicate values).
'##### Find duplicates in commodity column and highlight them ######
Dim myDataRng As Range
Dim cell As Range
Set myDataRng = Range("E10:E" & Cells(Rows.Count, "E").End(xlUp).Row)
For Each cell In myDataRng
cell.Offset(0, 0).Font.Color = vbBlack
If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then
cell.Offset(0, 0).Font.Color = vbRed
End If
Next cell
Any idea what it could be?
The error is not immediately obvious. I made a few tweaks to the code, however this should allow you to see what's being evaluated. Typically you'd get this error from the formula not being entered with the correct format, but it works on my end.
I removed the Offset(0,0) as it is superfluous at present with no offset applied, as well as placing the vbBlack formatting in an Else block for performance/clarity.
However seeing the Debug.Print statement should be critical for understanding when the code is not functioning. The only other thought I have, is you may want to clarify which sheet this Countif is being completed on.
Update
I've revised my answer to use SumProduct instead of CountIf to workaround the issue of 255 characters being the limit for CountIf.
Public Sub TestSub()
Dim myDataRng As Range
Dim cell As Range
Dim EvalStr As String
Set myDataRng = Range("E10:E" & Cells(Rows.Count, "E").End(xlUp).Row)
For Each cell In myDataRng
EvalStr = "SumProduct((" & myDataRng.Address & "=" & cell.Address & ")+0)"
If Application.Evaluate(EvalStr) > 1 Then
cell.Font.Color = vbRed
Else
cell.Font.Color = vbBlack
End If
Next cell
End Sub
Change your line:
If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then
With:
If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & " > 1 )") Then
In the following picture of an Excel sheet, the heading of the first column, and then of every 7th column after that, contains a month and a year.
I am trying to think of some code which would make entering complete dates under these headings faster. Since the month and the year are already present, I'm thinking there must be a way to enter just the day, and get the whole thing. For example, if "21" were entered in cell A26, "2/21/2015" would result.
Anyone have an idea for how I might get this output?
Edit: Thanks to the helpful replies on this forum, I figured out exactly how to do this. Here is the code for my finished product, in case anyone wants to do something similar:
Private Sub Worksheet_change(ByVal Selection As Range)
Set Sel = Selection
If Sel.Count > 1 Then
Exit Sub
End If
If (Sel.Column - 1) Mod 7 = 0 Or Sel.Column = 1 Then
'In my case, date columns always follow the pattern of 1, 8, 15...
If Sel.Value > 31 Or Sel.Value = "" Then
Exit Sub
Else
Sel.NumberFormat = "General"
Sel.Value = Left(Cells(1, Sel.Column), InStr(Cells(1, Sel.Column), ",") - 1) & " " & _
Sel.Value & Right(Cells(1, Sel.Column), 6)
Selection.NumberFormat = "m/d/yyyy"
End If
End If
End Sub
How about entering the day numbers, selecting the range where these day numbers are entered, and running the below:
Sub Add_month_year()
Dim c As Range
For Each c In Selection
c = Left(Cells(1, c.Column), InStr(Cells(1, c.Column), ",") - 1) & " " & _
c.Value & Right(Cells(1, c.Column), 6)
Next
End Sub
This should return the full dates in date code, which you can then format as you see fit.