Data validation allows numbers and some strings? - excel

I want to do a data validation in BFF!range("A3:A40"). I want to only allow numbers from 0 to 24 and in the same time the list of strings "A" , "B", "C", "D". The list is present in Liste!range("C2:C100").
here is the code for the first part (list of strings), but i don't know how to add the second part (numbers between 0 and 24).
Sub Data_Validation_Nom()
'change Sheet1 to suit
Set wsListe = ThisWorkbook.Worksheets("Liste")
Set wsBFF = ThisWorkbook.Worksheets("BFF")
Set range1 = wsListe.Range("C2:C100")
Set rng = wsBFF.Range("A3:A40")
With rng.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & wsListe.Name & "'!" & range1.Address
End With
End Sub
Can someone helps me please

Related

Trying to build a data validation list with array that keeps building

I am trying to build a data validation list that adds values to the list which is fed from a for loop. Right now, I have the for loop that generates values and then write them into a column.
What I am trying to accomplish is instead of writing them to a cell, I would like to write them directly to the data validation list. (So the program runs faster)
The "For Loop" is as shown:
Dim PlotRow As Integer
Set Layout = NewFile.ModelSpace.Layout 'Setting the layout to ModelSpace viewport
Layout.RefreshPlotDeviceInfo 'Refresh the current plot information
plotDevices = Layout.GetPlotDeviceNames() 'Setting the plotting view for this current layout
PlotRow = 18
Dim x As Integer
For x = LBound(plotDevices) To UBound(plotDevices)
Cells(PlotRow, 10) = plotDevices(x)
Debug.Print plotDevices(x)
PlotRow = PlotRow + 1
Next
I have tried modifying the data validation code written by Davy C. But with no success.
His link can be seen here: How to pass values from an array to a drop down list in a certain cell (not combo list) in excel VBA
The raw data validation code can be shown here:
Dim myArray
myArray = Array("1", "2", "3")
Range("A" & 1).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=myArray(0) & "," & myArray(1) & "," & myArray(2)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
I have the for loop running, and I have a good setup on how to write the data validation code. Instead of Cells(PlotRow, 10) I would like to put a data validation box for that cell in that column.

VBA Setting string value with changing string name

Hi I'm trying to create macro that will collect data from excell table. I create strings with similar names and ended by number. Please is there a way to loop over this strings ? This Code is not working, but will explain what I want to do.
Sub vzor()
Dim i As Integer
Dim input1, input2, input3, input4, input5, input6, input7, _
input8, input9, input10, input11, input12, input13, input14, _
input15, input16, input17, input18, input19, input20, input21, _
input22, input23, input24, input25, input26, input27, input28, _
input29, input30, input31, input32, input33, input34, input35, _
input36, input37, input38, input39, input40, input41, input42, _
input43, input44, input45, input46, input47, input48, input49, _
input50, input51, input52, input53, input54, input55, input56, _
input57, input58, input59, input60, input61, input62, input63, _
input64, input65, input66, input67 As String
For i = 2 To 67
If Range("B" & i).Value = "" Then
MsgBox "Please fill all required data (The cells with red fill)", vbOKOnly, "Missing data"
Range("B" & i).Select
Else
input & i = Range("B" & i).Value
End If
Next

This seems to be a perfect example for a dictionary
Option Explicit
Dim wb As Workbook, ws As Worksheet
Dim inputdict As Variant
Dim i As Long
Set inputdict = CreateObject("Scripting.Dictionary")
Set wb = ThisWorkbook 'Change if necessary
Set ws = wb.Sheets(1) 'Change if necessary
For i = 1 To 67
If ws.Cells(i, "B").Value = vbNullString Then
MsgBox "Please fill all required data (The cells with red fill)", vbOKOnly, "Missing data"
ws.Cells(i, "B").Select
Else
inputdict.Add i, ws.Cells(i, "B").Value
End If
Next i
This creates a dictionary (inputdict). The keys for this dictionary are integers defined by i ranging from 1 to 67. The values are the values in the cells as you specified in your code already.

Excel VBA Extract Specific Data from Column of Mixed Data

I have a list of Tyres form the internet, the list is 5,000 lines long in one column.
I need to extract from each line the data in BOLD ideally into the next column
EXAMPLE of TYRES
LS388 (145/70 R13 71T)
LS388 (155/65 R13 73T)
LS388 (155/65 R14 75T)
4-Seasons (155/65 R14 75T)
CT6 (155/70 R12 104N) 72EE
LS388 (155/70 R13 75T)
The problem is that the number can be between 59 and 120 and the letter could be H T V R N X Z and so on. Also the text could be anywhere within the line of data not always towards the end as shown.
There could be 100 variations to look for and
Rather than having one line of code to search for a LIKE 71T for each line of tyres, can I use a source table of these variations and reference them one by one in the code is some sort of loop? or other suggestions if in VBA appreciated
At the moment I have this VBA code for each possible variation, one line for each variant.
ElseIf ActiveCell.Value Like "*79S*" Then
ActiveCell.offset(0,1).Value = "79S"

Insert this formula in a cell it is assuming your string is present in column A, you can change it if it is not the case and check how many it extracts.
=MID(A1,SEARCH(" ",A1,SEARCH("R1?",A1))+1,SEARCH(")",A1)-SEARCH(" ",A1,SEARCH("R1?",A1))-1)
filter out the remaining ones, find some thing common in them and let me know and we can build another formula for those cells.

I recommend to use Regular Expressions for that if you need to do it with VBA. There is a pretty good explanation at
How to use Regular Expressions (Regex) in Microsoft Excel both in-cell and loops.
As pattern you could use something like .+\(.+ (.+)\).* (see https://regex101.com/r/jK1zKc/1/)
For a manual solution
Use Split text into different columns with the Convert Text to Columns Wizard to split into columns by the spaces.
Then do a simple replace ")" by "" in column D.
Or do the manual solution with VBA (assuming your data in column A):
Option Explicit
Sub SplitAndDelet()
Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
")", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)) _
, TrailingMinusNumbers:=True
Range("A:C,E:E").Delete Shift:=xlToLeft
End Sub

If you want to do this in vba you could set up an array of tyres and loop through them for each cell. for example if you had this on your sheet;
you could do something like this;
Public Sub FindTyres()
' Column to Loop
Dim col As String
col = "B"
' rows to Loop
Dim startRow As String
Dim endRow As String
startRow = "2"
endRow = "7"
' Get list of Tyres
Dim tyresArr()
tyresArr = getTyresArr()
' Set Range to Loop
Dim rng As Range, cell As Range
Set rng = Range(col & startRow & ":" & col & endRow)
' Looping through Array params
Dim tyre As Variant
' Loop through Cells
For Each cell In rng
currentCellVal = cell.Value
' Loop through tyres
For Each tyre In tyresArr
Debug.Print tyre
' if you find it do something
If InStr(1, currentCellVal, CStr(tyre)) <> 0 Then
MsgBox "Value " & CStr(tyre) & " Contained in Cell " & cell.Address
Exit For
End If
Next tyre
Next cell
End Sub
Private Function getTyresArr()
Dim tyresArr(3)
tyresArr(0) = "71T"
tyresArr(1) = "73T"
tyresArr(2) = "75T"
tyresArr(3) = "104N"
getTyresArr = tyresArr
End Function
Please note this assumes you will only ever have one tyre code per line.
you may get some false positives if these strings exist for other reasons.
you would need to enter all the codes into the function that returns the array.

Macro for Text to columns

Sub Macro9()
'
' Macro9 Macro
'
'
Selection.TextToColumns Destination := Range("A3"), DataType := xlFixedWidth, _
FieldInfo := Array(Array(0,1),Array(60,1),Array(63,1),Array(68,1),Array(71,1), _
Array(85,1),Array(88,1),Array(93,1),Array(99,1),Array(107,1),Array(111,1),Array _
(120,1),Array(123,1),Array(127,1),Array(130,1),Array(134,1),Array(143,1),Array( _
147,1),Array(157,1),Array(162,1),Array(165,1),Array(170,1),Array(202,1),Array( _
233,1),Array(236,1),Array(238,1),Array(248,1),Array(251,1),Array(260,1),Array( _
265,1),Array(277,1),Array(283,1),Array(287,1),Array(291,1),Array(295,1),Array( _
299,1),Array(302,1),Array(306,1),Array(310,1),Array(322,1),Array(326,1),Array( _
332,1),Array(335,1),Array(338,1),Array(344,1),Array(348,1),Array(356,1),Array( _
360,1),Array(367,1),Array(373,1),Array(375,1),Array(384,1),Array(387,1),Array( _
394,1),Array(398,1),Array(403,1),Array(409,1),Array(413,1),Array(419,1),Array( _
424,1),Array(429,1),Array(432,1),Array(438,1),Array(444,1),Array(449,1),Array( _
454,1),Array(458,1),Array(463,1),Array(468,1),Array(474,1),Array(478,1),Array( _
481,1),Array(484,1),Array(489,1),Array(493,1),Array(524,1),Array(554,1),Array( _
557,1),Array(563,1),Array(565,1),Array(577,1),Array(594,1),Array(613,1),Array( _
616,1),Array(620,1),Array(626,1),Array(629,1),Array(634,1),Array(646,1),Array( _
654,1),Array(659,1),Array(667,1),Array(669,1),Array(675,1),Array(683,1),Array( _
689,1),Array(696,1),Array(699,1),Array(706,1),Array(714,1),Array(717,1),Array( _
721,1),Array(728,1),Array(730,1),Array(743,1),Array(751,1),Array(754,1),Array( _
758,1),Array(767,1),Array(774,1),Array(779,1),Array(787,1),Array(790,1),Array( _
798,1),Array(805,1),Array(808,1),Array(817,1),Array(822,1),Array(826,1),Array( _
835,1),Array(845,1),Array(853,1),Array(857,1),Array(864,1),Array(869,1),Array( _
877,1),Array(881,1),Array(891,1),Array(895,1),Array(903,1),Array(912,1),Array( _
916,1),Array(920,1),Array(927,1),Array(933,1),Array(937,1),Array(941,1),Array( _
End Sub
I have 800 words in cell A3 in sheet input1, i recorded above macro by using function "Text to columns" in Excel 2007 which is giving error "Too many line continuations".
Can someone tell me the exact code please, indeed I want to add all the 800 words in different individual cells as one word in each cell in the same row.

I do not believe it is possible to tell the Macro Recorder to create longer lines so I do not think TextToColumns can be made to record this code for you.
You are using the fixed width option so words are starting at position 0, 60, 63, 68, 71 and so on. The start positions for about 120 words have been have been recorded so, if you wanted to build an array like this, you will have a lot of typing.
You say "words". To me that implies variable length strings separated by spaces. If that is correct, try the code below. It uses function Split to split cell A3 into words by space. These are then spread out along row 4 with any gaps created by double or triple spaces ignored.
Option Explicit
Sub SplitCell()
Dim CellCrnt As Long
Dim InxW As Long
Dim Word() As String
With Worksheets("input1")
Word = Split(.Range("A3"), " ")
CellCrnt = 1
For InxW = LBound(Word) To UBound(Word)
' Any double spaces will cause empty entries in Word.
' Ignore these empty entries
If Word(InxW) <> "" Then
.Cells(4, CellCrnt).Value = Word(InxW)
CellCrnt = CellCrnt + 1
End If
Next
End With
End Sub

Excel 2010 VBA Formula1 Referencing a Named Range *or* cell location with variable for tab name

In VBA (Excel 2010), I am
dynamically creating a named range list
using that list to create drop down choices in another column
When creating the drop down list, (a) using the named range doesn't seem to work, and (b) if I don't use the named range - and need to reference by sheet name and cell reference, I get into trouble because my sheet has just been renamed with today's date.
This is messy, I know, but here is what I have so far:
' find the name of the worksheet and replace it with today's date
Dim vTabOriginalName As String
Dim vTabDateName As String
Dim vRangeName As String
vRangeName = "StageListChoices"
vTabOriginalName = ActiveSheet.Name
vTabDateName = Format(Now(), "yyyy-mmm-dd")
ActiveSheet.Name = vTabDateName
'create a drop down list for the stage (col K)
Range("AK3").Value = "NO ACTIVITY"
Range("AK4").Value = "SOLICITATION"
Range("AK5").Value = "OPPORTUNITY"
ActiveWorkbook.Names.Add Name:="StageListChoices", RefersToR1C1:=(vTabDateName & "!R3C37:R5C37")
'~~> Creates the list
With Range("K2:K" & vReportRowCount).Validation 'report row count known earlier
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=StageListChoices"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
The recorded macro when I created the named region made sense enough:
ActiveWorkbook.Names.Add Name:="StageListChoices", RefersToR1C1:= _
"=2013-JAN-24!R3C37:R14C37"
ActiveWorkbook.Names("StageListChoices").Comment = ""
Originally, I had been creating the drop down in VBA with a String variable, but the "real" list is 15 items long and I was getting errors upon reopening the file that the validation had been too long (?) and so had been turned off.
Basically, I've tried things like:
Formula1:="=StageListChoices"
Formula1:=vRangeName
Formula1:="=vRangeName"
Formula1:=vTabDateName & "!R3C37:R5C37"
Everything I've looked up says that the first one (Formula1:="=StageListChoices") should have worked - but it doesn't.
Thank you!

Change
ActiveWorkbook.Names.Add Name:="StageListChoices", RefersToR1C1:=(vTabDateName & "!R3C37:R5C37")
to
ActiveWorkbook.Names.Add Name:="StageListChoices", RefersToR1C1:=("='" & vTabDateName & "'!R3C37:R5C37")
You were missing the = and the '

Resources