lionheart

First, manually unprotect the worksheet from Review tab and the command Unprotect Worksheet From [Developer] tab > click on [Design Mode] > Right-click the activex textbox and select the [Format Control] > from [Protection] tab, uncheck [Locked] option Exit [Design Mode] Finally, change the code in worksheet module (you may encounter the error message of protection for once then it will work normally) Private Sub TextBox1_Change() Const sPass As String = "2212" With ActiveSheet .Protect Password:=sPass, DrawingObjects:=False Application.ScreenUpdating = False .ListObjects("data").Range.AutoFilter Field:=7, Criteria1:="*" & [F2] & "*", Operator:=xlFilterValues Application.ScreenUpdating = True End With End Sub

the problem is simply because you refer to the incorrect column (Classes Column) while you should refer to the (Committee Column) so to fix change the column from F to G =MINIFS(data!A:A,data!G:G,H6)

Try this code Private Sub UserForm_Initialize() With Me.TextBox1 .Text = "Hello World" .Enabled = False End With End Sub Private Sub TextBox2_Change() Dim s As String, i As Long s = Me.TextBox2.Value For i = 1 To Len(s) If InStr(1, Me.TextBox1.Value, Mid(s, i, 1)) > 0 Then MsgBox Mid(s, i, 1) & " Is Found In TextBox1" s = Replace(s, Mid(s, i, 1), vbNullString) Me.TextBox2.Value = s Exit For End If Next i End Sub

Check the settings: Make sure the autocomplete option is turned on. To do this, go to File > Options > Advanced > Editing options and ensure that the "Enable AutoComplete for cell values" checkbox is ticked

Because the code extracts the unique values from column c regardless the order of the months. After the execution of the code you can cut the columns and reorder the results according to your needs

Try Sub Test() Dim lr As Long With ActiveSheet lr = .Cells(Rows.Count, 1).End(xlUp).Row ConvertData .Range("A1:D" & lr), .Range("H1") End With End Sub Public Sub ConvertData(ByVal sourceRange As Range, ByVal targetCell As Range) Const NAME_COL As Long = 2, MONTH_COL As Long = 3 Dim vName, vMonth, outputRange As Range, dicName As Object, dicMonth As Object, i As Long Set dicName = CreateObject("Scripting.Dictionary") Set dicMonth = CreateObject("Scripting.Dictionary") For i = 2 To sourceRange.Rows.Count If Not dicName.Exists(sourceRange(i, NAME_COL).Value) Then dicName.Add sourceRange(i, NAME_COL).Value, dicName.Count + 1 End If If Not dicMonth.Exists(sourceRange(i, MONTH_COL).Value) Then dicMonth.Add sourceRange(i, MONTH_COL).Value, dicMonth.Count + 1 End If Next i Set outputRange = targetCell.Resize(dicName.Count + 1, dicMonth.Count + 2) outputRange.Cells(1, 1).Value = "S" outputRange.Cells(1, 2).Value = "Name" For Each vMonth In dicMonth.Keys outputRange.Cells(1, dicMonth(vMonth) + 2).Value = vMonth Next vMonth For Each vName In dicName.Keys outputRange.Cells(dicName(vName) + 1, 1).Value = dicName(vName) outputRange.Cells(dicName(vName) + 1, 2).Value = vName For Each vMonth In dicMonth.Keys For i = 2 To sourceRange.Rows.Count If sourceRange(i, NAME_COL).Value = vName And sourceRange(i, MONTH_COL).Value = vMonth Then outputRange.Cells(dicName(vName) + 1, dicMonth(vMonth) + 2).Value = sourceRange(i, 4).Value Exit For End If Next i Next vMonth Next vName End Sub

Post a new topic for the new question

In standard module Private Declare Function IsNetworkAlive Lib "Sensapi" (lpdwFlags As Long) As Long Sub CheckInternetConnection() If Not IsInternetConnected() Then UserForm1.Show Application.OnTime Now + TimeValue("00:00:10"), "CheckInternetConnection" End Sub Public Function IsInternetConnected() As Boolean Dim lngAlive If IsNetworkAlive(lngAlive) = 1 Then IsInternetConnected = True End Function In workbook module Private Sub Workbook_Open() Application.OnTime Now + TimeValue("00:00:10"), "CheckInternetConnection" End Sub

Not so clear but try Sub Test() Dim c As Range For Each c In Range("A1").CurrentRegion.Cells If IsNumeric(c.Value) Then c.Value = c.Value + 1 Next c End Sub

Select the column of your desire Data tab > Text to Columns > Next > Uncheck Tab option > Next > Select Text option > Finish

The data don't seem to be logical at all Please attach a file with some logical data to know the real strucuture of the data

Tomorrow I will have a look as I am not available now

For Excel 365, use the following formula in cell D11 (Clear the range first from D11 to D25) then put the formula =TEXT(FILTER(SEQUENCE(DAY(EOMONTH(K6,0)),,EOMONTH(K6,-1)+1,1),WEEKDAY(SEQUENCE(DAY(EOMONTH(K6,0)),,EOMONTH(K6,-1)+1,1),1)>=6),"ddd") In cell E11, use the formula =TEXT(FILTER(SEQUENCE(DAY(EOMONTH(K6,0)),,EOMONTH(K6,-1)+1,1),WEEKDAY(SEQUENCE(DAY(EOMONTH(K6,0)),,EOMONTH(K6,-1)+1,1),1)>=6),"dd/mm/yyyy") For older version of excel ------------------------------- In cell D11, use the formula =IF(MONTH($K$6-MOD(WEEKDAY($K$6,1)-6-IF(WEEKDAY(DATE(YEAR($K$6),MONTH($K$6),1),1)=7,1,0),7)+IF(WEEKDAY($K$6,1)<6,7,0)+7*(INT((ROW()-11)/2)))=MONTH($K$6),$K$6-MOD(WEEKDAY($K$6,1)-6-IF(WEEKDAY(DATE(YEAR($K$6),MONTH($K$6),1),1)=7,1,0),7)+IF(WEEKDAY($K$6,1)<6,7,0)+7*(INT((ROW()-11)/2)),"") In cell D12, use the formula =IFERROR(IF(MONTH(IF(WEEKDAY(E11)=6,E11+1,IF(WEEKDAY(E11)=7,E11+6,"")))>MONTH($K$6),"",IF(WEEKDAY(E11)=6,E11+1,IF(WEEKDAY(E11)=7,E11+6,""))),"") Select the cells D11 & D12 and drag them Do the same exactly for E11 & E12

When you drag any formula it will be applied to all the cells in the column What purpose of avoiding the hidden cells not to have the formula

I don't have any more to introduce in this topic If you really need help, attach an excel file not csv file with some data and the desired output exactly

Not clear at all

I didn't get exactly what you mean Generally, you can imitate the desired card by creating a card manually then to have a look at it and modify the code according to your requirement I think you already have the solution for both creating vcards and exporting them to outlook

No need to change the headers to get what you need. I have opened outlook on my side and imitate creating VCards and this is the new working code for the first attachment and this will save the fields properly for you Sub Create_VCARDS() Dim ws As Worksheet, FirstName As String, LastName As String, FullName As String, Mobile As String, HomePhone As String, BusinessPhone As String, Email As String, vCard As String, sFolder As String, sFileName As String, lr As Long, i As Long Application.ScreenUpdating = False Set ws = ActiveSheet lr = ws.Cells(Rows.Count, "A").End(xlUp).Row sFolder = ThisWorkbook.Path & "\VCARDS\" If Len(Dir(sFolder, vbDirectory)) = 0 Then MkDir sFolder For i = 2 To lr With ws FirstName = .Cells(i, 1).Value LastName = .Cells(i, 2).Value FullName = FirstName & " " & LastName Mobile = .Cells(i, 3).Value HomePhone = .Cells(i, 4).Value BusinessPhone = .Cells(i, 5).Value Email = .Cells(i, 6).Value End With vCard = "BEGIN:VCARD" & vbCrLf vCard = vCard & "VERSION:3.0" & vbCrLf vCard = vCard & "N:" & LastName & ";" & FirstName & vbCrLf vCard = vCard & "FN:" & FullName & vbCrLf vCard = vCard & "TEL;TYPE=CELL:" & Mobile & vbCrLf vCard = vCard & "TEL;TYPE=HOME:" & HomePhone & vbCrLf vCard = vCard & "TEL;TYPE=WORK:" & BusinessPhone & vbCrLf vCard = vCard & "EMAIL;TYPE=INTERNET:" & Email & vbCrLf vCard = vCard & "END:VCARD" & vbCrLf sFileName = sFolder & FullName & ".vcf" Open sFileName For Output As #1 Print #1, vCard Close #1 Next i Application.ScreenUpdating = True MsgBox "Done", 64 End Sub The code will create a folder with the name `VCARDS` at the same path of your workbook and it will contains all the VCFs --------------------------------------------------------------------- Now after creating the VCards, you can use late binding in the code you attached to export all the VCards to Outlook at one shot. I prefer to get the outlook application open before executing the code Sub Save_VCARDS_To_OutLook() Dim fso As Object, fsDir As Object, fsFile As Object, objOL As Object, colInsp As Object, objWSHShell As Object, sFolder As String, strVCName As String sFolder = ThisWorkbook.Path & "\VCARDS" Set fso = CreateObject("Scripting.FileSystemObject") Set fsDir = fso.GetFolder(sFolder) For Each fsFile In fsDir.Files strVCName = """" & sFolder & "\" & fsFile.Name & """" Set objOL = CreateObject("Outlook.Application") Set colInsp = objOL.Inspectors If colInsp.Count = 0 Then Set objWSHShell = CreateObject("WScript.Shell") objWSHShell.Run strVCName Set colInsp = objOL.Inspectors If Err = 0 Then Do Until colInsp.Count = 1 DoEvents Loop colInsp.Item(1).CurrentItem.Save colInsp.Item(1).Close olDiscard Set colInsp = Nothing: Set objWSHShell = Nothing End If End If Set objOL = Nothing Next fsFile Set fsFile = Nothing: Set fsDir = Nothing: Set fso = Nothing MsgBox "Done", 64 End Sub

I didn't work on outlook but I think there must be a way to import the VCF from outlook at one shot

Try this code Sub Test() Dim ws As Worksheet, FirstName As String, LastName As String, FullName As String, Mobile As String, HomePhone As String, BusinessPhone As String, Email As String, vCard As String, sFolder As String, sFileName As String, lr As Long, i As Long Application.ScreenUpdating = False Set ws = ActiveSheet lr = ws.Cells(Rows.Count, "A").End(xlUp).Row sFolder = ThisWorkbook.Path & "\VCARDS\" If Len(Dir(sFolder, vbDirectory)) = 0 Then MkDir sFolder For i = 2 To lr With ws FirstName = .Cells(i, 1).Value LastName = .Cells(i, 2).Value FullName = FirstName & " " & LastName Mobile = .Cells(i, 3).Value HomePhone = .Cells(i, 4).Value BusinessPhone = .Cells(i, 5).Value Email = .Cells(i, 6).Value End With vCard = "BEGIN:VCARD" & vbCrLf vCard = vCard & "VERSION:3.0" & vbCrLf vCard = vCard & "N:" & LastName & ";" & FirstName & vbCrLf vCard = vCard & "FN:" & FullName & vbCrLf vCard = vCard & "TEL;TYPE=CELL:" & Mobile & vbCrLf vCard = vCard & "TEL;TYPE=CELL:" & HomePhone & vbCrLf vCard = vCard & "TEL;TYPE=CELL:" & BusinessPhone & vbCrLf vCard = vCard & "EMAIL;TYPE=INTERNET:" & Email & vbCrLf vCard = vCard & "END:VCARD" & vbCrLf sFileName = sFolder & FullName & ".vcf" Open sFileName For Output As #1 Print #1, vCard Close #1 Next i Application.ScreenUpdating = True MsgBox "Done", 64 End Sub

Great. It should work well as you used UTF-8 Can you upload the systool excel conveter you used? and why didn't you use excel vba code for that purpose Also upload sample of the desired vcard

I think you specified the wrong reply as the best answer. This is not useful for other members

How did you get the csv file? what is the code dis you use or the csv file is the raw data and you need to convert the data in it to vcard More details are required if you really need help

Sorry Use the line without this part : GoTo Skipper The line should be Columns(sColTarget).Rows(FirstRow & ":" & FirstRow + 1).ClearContents You have to be able to fix such issues by yourself

Update the office from File menu > Account > Update options > Update Now