This question already has answers here:
Create data validation list when some of the values have commas?
(4 answers)
Closed 7 years ago.
i am trying to create a data validation list using vba code. The array generate itself depending on many variable.
here is the code i am using
For iter4 = 2 To nbWsheet
If Wsheet.Cells(iter4, 2) = Cat And Wsheet.Cells(iter4, ColMod) = "x" And Wsheet.Cells(iter4, ColStd) = "oui" Then
TableValue = Wsheet.Cells(iter4, 4).Value & " - " & Wsheet.Cells(iter4, 7).Value
Table = Table & "," & TableValue
End If
Next iter4
'Ajout de la list
With Cells(iGlob, 5).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Table
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = ""
.ShowError = ""
End With
The problem with this code, is the text in the table contain ",". When the data validation list is generated, every time it see a "," it put the text on a new line...
Is there a way to keep the "," inside the table
Exemple of what i want to display : 123456 - Engine, 300HP
Hope i was clear,
Thanks,
I don't think there is an escape character for the comma in custom list. According to MSDN Validation.Add, the comma always separate the entries.
One workaround is to use Dynamic Named Range.
Use a spare column in a hidden sheet or somewhere, lets use Column A for demo
In A1, put in "DV_ListTable", Define the cell with name DV_ListTable
Highlight Column A, Define it as DV_ListColumn
Define another name using Name Manager as DV_List with RefersTo as
=OFFSET(DV_ListTable,1,0,IF(COUNTA(DV_ListColumn)-1=0,1,COUNTA(DV_ListColumn)-1))
Now the Data Validation will be (cell D1):
Then the macro to change this dynamic range contents will be:
Option Explicit
Sub ChangeDataValidationList()
Dim i As Long, Table As String, TableValue As String
Dim oRng As Range, oValues As Variant
With ThisWorkbook
' Build up the new table list
Table = .Names("DV_ListTable").RefersToRange.Value ' Header
' For Demo, the data is from Columns next to the DV_ListTable
Set oRng = .Names("DV_ListTable").RefersToRange.Offset(0, 1)
Do Until IsEmpty(oRng)
TableValue = oRng.Value & " - " & oRng.Offset(0, 1).Value
Table = Table & vbCrLf & TableValue
Set oRng = oRng.Offset(1, 0)
Loop
Set oRng = Nothing
' Clear the contents in the column
.Names("DV_ListColumn").RefersToRange.ClearContents
' Paste in the values separated by vbCrLf
oValues = Application.Transpose(Split(Table, vbCrLf))
.Names("DV_ListTable").RefersToRange.Resize(UBound(oValues)) = oValues
Set oValues = Nothing
End With
End Sub
Sample screenshot after "ChangeDataValisationList" executed:
Hope this helps you on the right direction for a work around.
Replace "," with Chr(44). The Chr function returns a string based on the VBA character code. I find it also comes in handy when you want to insert a double-quote (Chr(34) for a double quote).
Related
I'm quite new at VBA. I've used it in excel for a couple macros, but this one is way above my head.
I'm looking to create a macro that will find the appropriate column, then based on the value in this columns, changes the values in three other columns. I already have a static macro:
Sub AdjustForNoIntent()
'Adjusts columns Role(U) (to C-MEM), REV Profile Follow-up Date(AJ) (to N/A) and deletes Follow-up Date(Y) when column Survey: Intent to Participate = No
Dim lastrow As Long
Dim i As Long
lastrow = Range("AE" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Not IsError(Range("AE" & i).Value) Then
If Range("AE" & i).Value = "No" And Range("U" & i).Value = "MEM" Then
Range("U" & i).Value = "C-MEM"
Range("Y" & i).ClearContents
Range("AJ" & i).Value = "N/A"
ElseIf Range("AE" & i).Value = "No" And Range("U" & i).Value = "VCH" Then
Range("U" & i).Value = "C-VCH"
Range("Y" & i).ClearContents
Range("AJ" & i).Value = "N/A"
End If
End If
Next i
End Sub
But this is a shared workbook, so people are adding columns randomly and every time I need to go back to the code and modify the columns refereces. What I want is, for instance, to look for column with "Role" header in row A3 and to insert it where the macro looks for column "U". That way other users can add/delete columns but I won't have to modify the macro every time.
In other macros, I manage to have this thing working:
Function fnColumnNumberToLetter(ByVal ColumnNumber As Integer)
fnColumnNumberToLetter = Replace(Replace(Cells(1,ColumnNumber).Address, "1", ""), "$", "")
End Function
Dim rngColumn As Range
Dim ColNumber As Integer
Dim ColName As String
ColName = "Email Address"
Sheets("Tracking").Select
Set rngColumn = Range("3:3").Find(ColName)
ColNumber = Sheets("Tracking").Range(rngColumn, rngColumn).Column
Sheets("Combined").Range(ActiveCell, "W2").FormulaLocal = "=IF(ISERROR(INDEX(Tracking!$A:$A,MATCH(O:O,Tracking!" & fnColumnNumberToLetter(ColNumber) & ":" & fnColumnNumberToLetter(ColNumber) & ",0))), INDEX(Tracking!$A:$A,MATCH(U:U,Tracking!" & fnColumnNumberToLetter(ColNumber) & ":" & fnColumnNumberToLetter(ColNumber) & ",0)), INDEX(Tracking!$A:$A,MATCH(O:O,Tracking!" & fnColumnNumberToLetter(ColNumber) & ":" & fnColumnNumberToLetter(ColNumber) & ",0)))"
However, I am unable to link the latter to the first and much less to get it to find multiple columns. Any help is appreciated.
EDIT:
Following suggestions, here is the new code. Doesn't return an error, but doesn't do anything either. It loops through the c loop ok, but jumps from For i =2 ... line to End Sub.
Sub Adjust()
Dim lastrow As Long
Dim i As Long
Dim headers As Dictionary
Dim c As Long
Set headers = New Scripting.Dictionary
For c = 1 To Cells(3, Columns.Count).End(xlToLeft).Column
headers.Add Cells(3, c).Value, c
Next c
lastrow = Cells(headers.Item("Survey: Interest to Participate") & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Not IsError(Cells(i, headers.Item("Survey: Interest to Participate")).Value) Then
If Cells(i, headers.Item("Survey: Interest to Participate")).Value = "No" And Cells(i, headers.Item("Role")).Value = "MEM" Then
Cells(i, headers.Item("Role")).Value = "C-MEM"
Cells(i, headers.Ittem(" Follow-up date")).ClearContents
Cells(i, headers.Item("REV profile follow-up date")).Value = "N/A"
ElseIf Cells(i, headers.Item("Survey: Interest to Participate")).Value = "No" And Cells(i, headers.Item("Role")).Value = "VCH" Then
Cells(i, headers.Item("Role")).Value = "C-VCH"
Cells(i, headers.Ittem(" Follow-up date")).ClearContents
Cells(i, headers.Item("REV profile follow-up date")).Value = "N/A"
End If
End If
Next i
End Sub
The way I'd go about this would be to create a Dictionary with header names as keys and column numbers as values:
Dim headers As Dictionary
Set headers = New Scripting.Dictionary
Dim c As Long
'Assuming headers are in row 1 for sake of example...
For c = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
headers.Add Cells(1, c).Value, c
Next
Then, instead of using hard-code column letters with the Range, use the Cells collection and index it by column number using the Dictionary to look it up based on the header. For example, if your code expects column "U" to be under that header "Role" here:
Range("U" & i).Value = "C-MEM"
You can replace it with a column lookup like this using the Dictionary like this:
Cells(i, headers.Item("Role")).Value = "C-MEM"
Note that this requires a reference to the Microsoft Scripting Runtime (Tools->References... then check the box).
But this is a shared workbook, so people are adding columns randomly and every time I need to go back to the code and modify the columns refereces.
Protect the workbook to prevent this undesired behavior?
I would personally prefer to use Named Ranges, which will adjust with insertions and re-sorting of the data columns.
From Formulas ribbon, define a new name:
Then, confirm that you can move, insert, etc., with a simple procedure like:
Const ROLE As String = "Role"
Sub foo()
Dim rng As Range
Set rng = Range(ROLE)
' This will display $B$1
MsgBox rng.Address, vbInformation, ROLE & " located:"
rng.Offset(0, -1).Insert Shift:=xlToRight
' This will display $C$1
MsgBox rng.Address, vbInformation, ROLE & " located:"
rng.Cut
Application.GoTo Range("A100")
ActiveSheet.Paste
' This will display $A$100
MsgBox rng.Address, vbInformation, ROLE & " located:"
End Sub
So, I would define a Named Range for each of your columns (presently assumed to be AE, U, Y & AJ). The Named Range can span the entire column, which will minimize changes to the rest of your code.
Given 4 named ranges like:
Role, representing column U:U
RevProfile, representing column AJ:AJ
FollowUp, representing column Y:Y
Intent, representing column AE:AE
(NOTE: If you anticipate that users may insert rows above your header rows, then I would change the Named range assignments to only the header cells, e.g., "$AE$1", "$U$1", etc. -- this should require no additional changes to the code below)
You could do like this:
'Constant strings representing named ranges in this worksheet
Public Const ROLE As String = "Role"
Public Const REVPROFILE As String = "RevProfile"
Public Const FOLLOWUP As String = "FollowUp"
Public Const INTENT As String = "Intent"
Sub AdjustForNoIntent()
'Adjusts columns Role(U) (to C-MEM), REV Profile Follow-up Date(AJ) (to N/A) and deletes Follow-up Date(Y) when column Survey: Intent to Participate = No
Dim lastrow As Long
Dim i As Long
lastrow = Range(INTENT).End(xlUp).Row
For i = 2 To lastrow
If Not IsError(Range(INTENT).Cells(i).Value) Then
If Range(INTENT).Cells(i).Value = "No" And Range(ROLE).Cells(i).Value = "MEM" Then
Range(ROLE).Cells(i).Value = "C-MEM"
Range(FOLLOWUP).ClearContents
Range(REVPROFILE).Cells(i).Value = "N/A"
ElseIf Range(INTENT).Cells(i).Value = "No" And Range(ROLE).Cells(i).Value = "VCH" Then
Range(ROLE).Cells(i).Value = "C-VCH"
Range(FOLLOWUP).Cells(i).ClearContents
Range(REVPROFILE).Value = "N/A"
End If
End If
Next
End Sub
I would go with David Zemens answer but you could also use Range().Find to get the correct columns.
Here I refactored you code to find and set references to your column headers. Everything is based relative to these references.
Here I set a reference to Row 3 of the Survey column where your column header is:
Set rSurvey = .Rows(3).Find(What:="Survey", MatchCase:=False, Lookat:=xlWhole)
Because everything is relative to rSurvey the last row is = the actual last row - rSurvey's row
lastrow = rSurvey(.Rows.Count - rSurvey.Row).End(xlUp).Row - rSurvey.Row
Since rSurvey is a range we know that rSurvey.Cells(1, 1) is our column header. What isn't apparent is that since rSurvey is a range rSurvey(1, 1) is also our column header and since column and row indices are optional rSurvey(1) is also the column header cell.
Know all of that we can iterate over the cells in each column like this
For i = 2 To lastrow
rSurvey( i )
Sub AdjustForNoIntent()
'Adjusts columns Role(U) (to C-MEM), REV Profile Follow-up Date(AJ) (to N/A) and deletes Follow-up Date(Y) when column Survey: Intent to Participate = No
Dim lastrow As Long
Dim i As Long
Dim rRev As Range 'AJ
Dim rRole As Range 'U
Dim rFollowUp As Range 'Y
Dim rSurvey As Range 'AE
With Worksheets("Tracking")
Set rRev = .Rows(3).Find(What:="REV", MatchCase:=False, Lookat:=xlWhole)
Set rRole = .Rows(3).Find(What:="Role", MatchCase:=False, Lookat:=xlWhole)
Set rFollowUp = .Rows(3).Find(What:="Follow-up", MatchCase:=False, Lookat:=xlWhole)
Set rSurvey = .Rows(3).Find(What:="Survey", MatchCase:=False, Lookat:=xlWhole)
lastrow = rSurvey(.Rows.Count - rSurvey.Row).End(xlUp).Row - rSurvey.Row
End With
For i = 2 To lastrow
If Not IsError(rSurvey(i).value) Then
If rSurvey(i).value = "No" And rRole(i).value = "MEM" Then
rRole(i).value = "C-MEM"
rFollowUp(i).ClearContents
rRev(i).value = "N/A"
ElseIf rSurvey(i).value = "No" And rRole(i).value = "VCH" Then
rRole(i).value = "C-VCH"
rFollowUp(i).ClearContents
rRev(i).value = "N/A"
End If
End If
Next i
End Sub
I am fairly new to VBA, but I am decently experienced with Java and Python. I was given the task of organizing a nearby school's grading standards on an excel spreadsheet, and I wanted to give the teachers the option to reorganize the spreadsheet at the click of a button, so I have decided to use VBA.
This is what I have so far for my code (it's sloppy, but I will clean it up once I get it working well):
Private Sub Workbook_Open()
' Initialize Variables
Dim i%, j%
Dim vTemp$, StdList$
Dim Stds As Collection
Set Stds = New Collection
' Compute the index of the last Standard on Test worksheet
lastStd = Sheet3.Range("B" & Rows.Count).End(xlUp).Row
' Remove Duplicates from the Standards and remove commas
On Error Resume Next
For i = 2 To lastStd
Stds.Add (Sheet3.Cells(i, 2)), Chr(34) & (Sheet3.Cells(i, 2)) & Chr(34)
Next i
On Error GoTo 0
For i = 1 To Stds.Count
Stds.Item(i) = Replace(Stds.Item(i), ",", Chr(130))
Next i
' Sort the Standards Alphabetically (using Bubble Sort)
For i = 1 To Stds.Count - 1
For j = i + 1 To Stds.Count
If Stds(i) > Stds(j) Then
vTemp = Stds(j)
Stds.Remove (j)
Stds.Add vTemp, vTemp, i
End If
Next j
Next i
' Reinitialize Cell Data
Sheet8.Range("A1:J100").Clear
For i = 1 To Stds.Count
Sheet8.Cells(i, 1).Value = Stds.Item(i)
Next i
' Output the Standards to the Excel Spreadsheet
For i = 1 To Stds.Count
StdList = StdList & Stds.Item(i) & ","
Next i
With ThisWorkbook.Sheets("Sheet1").Range("F3").Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidateAlertStop, _
Formula1:=StdList
End With
End Sub
The code executes when I open up the spreadsheet, but I get "Run Time Error 1004 'Application Defined or Object Defined Error'" upon execution. The goal is to have the code search through the grading standards, enumerate a collection, remove the duplicates, sort the standards alphabetically, and replace the commas with a character that looks like a comma so that I can convert the collection to a list and place that list into a drop down list somewhere on the spreadsheet. When I select the debug option, these three lines are highlighted:
.Add Type:=xlValidateList, _
AlertStyle:=xlValidateAlertStop, _
Formula1:=StdList
My guess is that I am either struggling with the syntax, or there is a type mismatch somewhere in there that I am not seeing; both of which are likely.
You can run debug.print on your parameters - that would point out that xlValidateAlertStop was empty
It should actually be xlValidAlertStop
Another solution to avoide one loop is to use Scripting.Dictionary object
Sub SubDicList()
'With a CD's Collection DataBase
'|Group And singer |Album Title| Date| Price| Qty | Web Link|
'MainList is DataField of Group and singer
'SubList is The Dropdown Validation List to get from DataField of Album TiTle
Dim ws As Worksheet, nRow As Long, i As Integer
Dim MainList As Range, MainData As Range, DataSelected As Variant
Dim SubList As String, SubData As Variant
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Set ws = Worksheets("Data")
DataSelected = Range("K4") 'Data validation from a dropdown list with MainList Content
nRow = ws.Cells(2 ^ 20, 2).End(xlUp).Row 'Last row
Set MainList = ws.Range(ws.Cells(5, 2), ws.Cells(nRow, 2)) 'MainList as Range (Group and Singers)
For Each MainData In MainList
If MainData.Value = DataSelected Then
SubData = MainData.Offset(0, 1) 'SubData is Album Title of Group and singers
If Not Dic.Exists(SubData) Then 'If Album Title is not in the Sripting Dictionary
Dic.Add SubData, CStr(SubData) 'Add Allbum Titel to the Sripting Dictionary
SubList = SubList & SubData & "," 'Prepare the Validation List for each step of loop
End If
End If
Next MainData
With Range("L4").Validation 'Range("L4"): Where to put the Data Validation Dropdown List
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=SubList
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Set Dic = Nothing
Set MainList = Nothing
Set ws = Nothing
End Sub
I'm trying to make a function to do the following:
Cycle through all my datasets in my sheet
Cycle through each column in my datasets
Look at the title for that column and check if it is in my list.
Find find a few various other columns, but this time using .Find
Now cycle through each row in the column for that specific dataset
Use the column references found in point 4 and the row from point 5 to put the cell's into a variable that will be used on step 7 which is to insert a formatted comment in the originally found column (for that row).
I've tried getting some code working from what I found on a different site but I can't get it working correct, I'm stuck at part 5.
A data example could look like:
My attempted code looks like:
Sub ComTest()
COMLIST = ";Cond;"
Set rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each a In rng.SpecialCells(xlCellTypeConstants).Areas
With a.CurrentRegion
Set r = .Rows(1)
For j = 1 To r.Columns.Count
TitleCell = r.Cells(j).Address
v = ";" & Range(TitleCell).Value & ";"
'-----------------------------------------------------------------------------------------
If InStr(1, COMLIST, v) Then
On Error Resume Next
xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
For i = 1 To UBound(xRange)
v = b.Value
Next i
Condw = r.Columns.Find(Replace(v, ";", "") & " " & "w", lookAt:=xlWhole).Column
Condw = .Cells(r, Condw).Address
' Add more stuff here
End If
'-----------------------------------------------------------------------------------------
Next j
End With
Next a
End Sub
As for part 7, the output would essentially be as follows for "row 1" but this part I should be able to do, it's the looping part that I am struggling with.
This question raises a few points that this answer might resolve for you and others in the future:
I note that not many of your previous questions have accepted answers, and that several of them present answers but you have needed to respond by saying it doesn't suit your needs for a certain reason. It suggests you aren't really providing the right details in your question. I think that's the case here. Perhaps you could outline the outcome you are trying to achieve and, especially for Excel VBA, the precise structure of your spreadsheet data. It's tempting to think in this question that you simply want to know how to take the values of Columns C to F and write them to a comment in Column B for any row that contains data.
Using web code can often take more time to understand and adapt than learning the code syntax from first principles. Your provided code is difficult to follow and some parts seem odd. I wonder, for example, what this snippet is meant to do:
xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
For i = 1 To UBound(xRange)
v = b.Value
Next i
Using Option Explicit at the top of your module (which forces you to declare your variables) makes VBA coding and debugging much easier, and code submitted on SO is easier to follow if we can see what data types you meant variables to hold.
If your question is merely "How do I take the values of Columns C to F and write them to the cell in Column B for any row that contains data?", then your code could be as simple as:
Dim condCol As Range
Dim cell As Range
Dim line1 As String
Dim line2 As String
Dim cmt As Comment
'Define the "Cond" column range
'Note: this is an unreliable method but we'll use it here for the sake of brevity
Set condCol = ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns("B")
'Delete any comment boxes
condCol.ClearComments
'Loop through the cells in the column and process the data if it's a number
For Each cell In condCol.Rows
If Not IsEmpty(cell.Value) And IsNumeric(cell.Value) Then
'Acquire the comment data
line1 = "Cond: " & cell.Offset(, 1).Value & "/" & cell.Offset(, 2).Value & _
" (" & Format(cell.Offset(, 3), "0.00%") & ")"
line2 = "Cond pl: $" & cell.Offset(, 4).Value
Set cmt = cell.AddComment(line1 & vbCrLf & line2)
'Format the shape
With cmt.Shape.TextFrame
.Characters(1, 5).Font.Bold = True
.Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
.AutoSize = True
End With
End If
Next
If, on the other hand, your question is that you have unreliable data on your spreadsheet and your only certainty is that the headings exist on any one row, then some form of search routine must be added. In that case your code could look like this:
Dim rng As Range
Dim rowRng As Range
Dim cell As Range
Dim condCol(0 To 4) As Long
Dim line1 As String
Dim line2 As String
Dim allHdgsFound As Boolean
Dim i As Integer
Dim cmt As Comment
Set rng = ThisWorkbook.Worksheets("Sheet1").UsedRange
rng.ClearComments
For Each rowRng In rng.Rows
If Not allHdgsFound Then
'If we haven't found the headings,
'loop through the row cells to try and find them
For Each cell In rowRng.Cells
Select Case cell.Value
Case Is = "Cond": condCol(0) = cell.Column
Case Is = "Cond w": condCol(1) = cell.Column
Case Is = "Cond r": condCol(2) = cell.Column
Case Is = "Cond %": condCol(3) = cell.Column
Case Is = "Cond wpl": condCol(4) = cell.Column
End Select
Next
'Check if we have all the headings
'by verifying the condCol array has no 0s
allHdgsFound = True
For i = 0 To 4
If condCol(i) = 0 Then
allHdgsFound = False
Exit For
End If
Next
Else
If Not IsEmpty(rowRng.Cells(1).Value) Then
'The cell has values so populate the comment strings
line1 = "Cond: " & rowRng.Columns(condCol(1)).Value & "/" & _
rowRng.Columns(condCol(2)).Value & _
" (" & Format(rowRng.Columns(condCol(3)).Value, "0.00%") & ")"
line2 = "Cond pl: $" & rowRng.Columns(condCol(4))
Set cmt = rowRng.Columns(condCol(0)).AddComment(line1 & vbCrLf & line2)
'Format the shape
With cmt.Shape.TextFrame
.Characters(1, 5).Font.Bold = True
.Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
.AutoSize = True
End With
Else
'We've reached a blank cell so re-set the found values
allHdgsFound = False
Erase condCol
End If
End If
Next
Of course your data might be structured in any number of other ways, but we don't know that. My point is that if you can be more specific in your question and provide an outcome you are trying to achieve, you are likely to receive answers that are more useful to you.
I am trying to add a unique ID only when a cell in a range is blank. This way it will keep old IDs but will create unique IDs for new lines. For the code below I am trying to create and ID using the number 14 (for 2014), and using two other variables in my dataset that are numeric (ADPNumber and PRJNumber). Then the id would vary by the integer "i", which has to be 4 digits. I get runtime error 13 for the code below on the line that says "Set myCell..."
For Each myCell In ActiveSheet.Range("a9:a89").Cells
Dim i
i = 1
'i.NumberFormat = "0000"
If myCell.Value = "" Then
Set myCell = "14" & ADPNumber & PRJNumber & Format(i, "0000")
i = i + 1
End If
Next myCell
Try:
myCell.Value = "14" & ADPNumber & PRJNumber & Format(i, "0000")
I have VBA code which converts a given specific date format into a normal Date. Is there a way in which I can replace the entire column into my new date format may be by a button click or just using a function.
The code I have is:
Function CONVDATE(myDate) As Date
Dim arr
arr = Split(myDate)
CONVDATE = arr(1) & " " & arr(2) & " " & arr(5) & " " & arr(3)
End Function
Immediately to the right of your data enter:
=TEXT(LEFT(A1,11)&RIGHT(A1,4),"ddd mm dd yyyy")
and double-click the fill handle. Then select, Copy and Paste Special Values over the top.
If you want a VBA solution, and you are happy with your CONVDATE function, you can use something like the following to convert an entire column:
===================================
Option Explicit
Sub CONVALLDATES()
Dim RNG As Range, C As Range
'Next line may change depending on how your range to convert is set up
Set RNG = Range("A1", Cells(Rows.Count, "A").End(xlUp))
'Uncomment next line when debugged.
'application.ScreenUpdating = False
For Each C In RNG
With C
.Value = CONVDATE(C)
'.numberformat = whatever format you want it displayed
End With
Next C
Application.ScreenUpdating = True
End Sub
'---------------------------------------------
Function CONVDATE(myDate) As Date
Dim arr
arr = Split(myDate)
CONVDATE = arr(1) & " " & arr(2) & " " & arr(5) & " " & arr(3)
End Function
====================================
You should add some error checking to ensure the string you are trying to convert is, indeed, in the specific format.