Macros/VBA not working

Hi,

Thank you for your reply. I do understand download xlsm file may be insecured and hence I am writing below the code as I did not found required details from the article sent by you:

Option Base 1
Public Function FindColumn(ByVal Diveice As String, ByVal FN As String, ByVal ShN As String) As Variant

ra = Workbooks(FN).Worksheets(ShN).Cells(65536, 1).Row
CA = Workbooks(FN).Worksheets(ShN).Cells(1, 255).Column

''''''''''''''''''''''''''''
'Find Diveice_S in source1
''''''''''''''''''''''''''''
For i = 1 To ra
For j = 1 To CA
X = Workbooks(FN).Worksheets(ShN).Cells(i, j)
If StrComp(X, Diveice, vbTextCompare) = 0 Then
'arw_s = i
FindColumn = j
End If
If FindColumn > 0 Then
Exit For
End If
Next j
If FindColumn > 0 Then
Exit For
End If
Next i
'''''''''''''''''''''''''''''''
End Function

Public Function FindRow(ByVal Diveice As String, ByVal FN As String, ByVal ShN As String) As Variant

ra = Workbooks(FN).Worksheets(ShN).Cells(65536, 1).Row
CA = Workbooks(FN).Worksheets(ShN).Cells(1, 255).Column
''''''''''''''''''''''''''''
'Find Diveice_S in source1
''''''''''''''''''''''''''''
For i = 1 To ra
For j = 1 To CA
X = Workbooks(FN).Worksheets(ShN).Cells(i, j)
If StrComp(X, Diveice, vbTextCompare) = 0 Then
FindRow = i
'FindColumn = j
End If
If FindRow > 0 Then
Exit For
End If
Next j
If FindRow > 0 Then
Exit For
End If
Next i
'''''''''''''''''''''''''''''''
End Function

Public Function FindColumn_In_Row(ByVal val_name As String, ByVal Ob_Sheet As Worksheet, ByVal Val_Row As Variant) As Variant


Dim Final_Col As Variant
Dim Val_Col As Variant

Final_Col = Fun_FinalCol(Ob_Sheet, Val_Row)
''''''''''''''''''''''''''''
'Find Diveice_S in source1
''''''''''''''''''''''''''''
Val_Col = 0
For j = 1 To Final_Col
curr_cell = CStr(Ob_Sheet.Cells(Val_Row, j).Value)
If StrComp(curr_cell, val_name, vbTextCompare) = 0 Then
Val_Col = j
Exit For
End If

Next j

FindColumn_In_Row = Val_Col
'''''''''''''''''''''''''''''''
End Function
Public Function FindRow_In_Col(ByVal val_name As String, ByVal Ob_Sheet As Worksheet, ByVal Val_Col As Variant) As Variant


Dim Final_Row As Variant
Dim Val_Row As Variant

Final_Row = Fun_FinalRow(Ob_Sheet, Val_Col)
''''''''''''''''''''''''''''
'Find Diveice_S in source1
''''''''''''''''''''''''''''
Val_Row = 0
For i = 1 To Final_Row
curr_cell = CStr(Ob_Sheet.Cells(i, Val_Col).Value)
If StrComp(curr_cell, val_name, vbTextCompare) = 0 Then
Val_Row = i
Exit For
End If

Next i

FindRow_In_Col = Val_Row
'''''''''''''''''''''''''''''''
End Function
'find last column in a spesific row
Public Function Fun_FinalCol(ByVal Ob_Sheet As Worksheet, ByVal Val_Row As Variant) As Variant

count_Col = Ob_Sheet.Columns.Count
Fun_FinalCol = Ob_Sheet.Cells(Val_Row, count_Col).End(xlToLeft).Column

End Function

'find last row in a spesific column
Public Function Fun_FinalRow(ByVal Ob_Sheet As Worksheet, ByVal Val_Col As Variant) As Variant

Count_Row = Ob_Sheet.Rows.Count
Fun_FinalRow = Ob_Sheet.Cells(Count_Row, Val_Col).End(xlUp).Row

End Function



Public Function GetUniqueValues(ByVal values As Variant) As Variant
Dim result As Collection
Dim cellValue As Variant
Dim Arr_Val() As Variant
Set result = New Collection
Set GetUniqueValues = result

On Error Resume Next

For Each cellValue In values
If Trim(cellValue) = "" Then
Else
On Error Resume Next
result.Add Trim(cellValue), Trim(cellValue)
End If

Next cellValue
count_Col = result.Count
t = 1
For i = 1 To count_Col Step 1
ReDim Preserve Arr_Val(t)
Arr_Val(t) = result.Item(i)
t = t + 1
Next i
GetUniqueValues = Arr_Val
End Function

'Searching File
Public Function Fun_FindOpenFile(ByVal File_Name_Search As String) As Boolean


Dim Val_Count As Long
Dim Val_Current_FN As String

''''''''''
'amount of open files
Val_Count = Workbooks.Count
''''''''''
''''''''''
'Searching File
''''''''''
Fun_FindOpenFile = False

If Val_Count < 1 Then

Fun_FindOpenFile = False

Else

For i = 1 To Val_Count


Val_Current_FN = Workbooks.Item(i).Name
If StrComp(Val_Current_FN, File_Name_Search, vbTextCompare) = 0 Then

Fun_FindOpenFile = True

End If

If Fun_FindOpenFile Then

Exit For

End If

Next i

End If

End Function
Public Function Fun_FindFile_in_Folder(ByVal Path_SourceFile As String, ByVal Name_SourceFile As String) As Boolean


Dim Val_Current_FN As String
Dim ARR_Current_FN() As String



Fun_FindFile_in_Folder = False
'''''''''''''''''''''''
''''''''''''''''''''''''
'creat arrray from names of the files in folder Path_SourceFile
Val_Current_FN = Dir(Path_SourceFile) ' peremennoj ArFName1 prisvaivaetsa pervoje ima fajla

Do While Val_Current_FN <> vbNullString
If Val_Current_FN <> "." And Val_Current_FN <> ".." Then
t = t + 1
ReDim Preserve ARR_Current_FN(t)
ARR_Current_FN(t) = Val_Current_FN

End If

Val_Current_FN = Dir

Loop
'''''''''''''''''''''''''
'''''''''''''''''''''''''
' Search for Name_SourceFile in Array of Files
For i1 = 1 To t
If StrComp(ARR_Current_FN(i1), Name_SourceFile, vbTextCompare) = 0 Then

Fun_FindFile_in_Folder = True

Exit For
End If
Next i1


End Function

Public Sub start_import()
Load UserForm1
UserForm1.Show
Bool_UF = True
End Sub
Function GetFolder(strPath As String) As String
On Error Resume Next
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFilePicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

Public Function Get_OpenFile(ByVal File_Path As String, ByVal File_Name As String) As Boolean

Dim Bool_Result As Boolean
Dim Bool_Check As Boolean
Dim FSO As New FileSystemObject
Dim Ob_File As Workbook

Bool_Result = False
'''''''''''''''''''
'Check path
If Len(File_Path) <= 0 Then
Get_OpenFile = Bool_Result
Exit Function
End If

last_val = Right(File_Path, 1)
If StrComp(last_val, "\", vbTextCompare) <> 0 Then
File_Path = File_Path & "\"
End If
Bool_Check = FSO.FolderExists(File_Path)
If Not Bool_Check Then
Get_OpenFile = Bool_Result
Exit Function
End If
'''''''''''''''''''
'check file name
If Len(File_Name) <= 0 Then
Get_OpenFile = Bool_Result
Exit Function
End If
'if file is open
Set Ob_File = Nothing
On Error Resume Next
Set Ob_File = Workbooks(File_Name)
If Ob_File Is Nothing Then
Else
Ob_File.Close (False)
End If
'if file is in filder
Bool_Check = FSO.FileExists(File_Path & File_Name)
If Bool_Check Then
Workbooks.Open (File_Path & File_Name)
Get_OpenFile = True
Exit Function
Else
Get_OpenFile = False
Exit Function
End If


End Function
Public Function Get_FilesFromFolder(ByVal Str_Path As String, ByVal Str_Flag As String, ByVal Str_FileType As String) As Variant
''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''
'variebles for module
Dim ArrName_Source_Files() As String
''''''''''''''''''''''''''
''''''''''''''''''''''''''
'Check path
If Len(Str_Path) = 0 Then
Exit Function
End If

last_val = Right(Str_Path, 1)
If last_val <> "\" Then
Str_Path = Str_Path & "\"
End If
''''''''''''''''''''''''''
''''''''''''''''''''''''''
'macros file name (will not include it to list of files)

If Len(Str_FileType) > 0 Then
File_Name = Dir(Str_Path & "*" & Str_FileType & "*")
Else
File_Name = Dir(Str_Path, vbNormal)
End If

CurFile = ThisWorkbook.Name
i = 1
Do While File_Name <> vbNullString

If StrComp(CurFile, File_Name, vbTextCompare) = 0 Then
Else
If Len(Str_FileType) > 0 Then
If InStr(1, File_Name, Str_Flag, vbTextCompare) > 0 Then

ReDim Preserve ArrName_Source_Files(i)
ArrName_Source_Files(i) = File_Name
i = i + 1
End If

Else

ReDim Preserve ArrName_Source_Files(i)
ArrName_Source_Files(i) = File_Name
i = i + 1
End If

End If

File_Name = Dir()
Loop

Get_FilesFromFolder = ArrName_Source_Files


End Function


Let me know if you need further clarification.