AckeemK
asked on
Looking to make a macro more sophisticated when importing a file into a workbook
Essentially, I am looking to make a macro I already have in place more sophisticated. Depending on the file that is imported, columns can be located in different places. The macro I have in place I believe is focused on positions and based on three different files. However, depending on the file being imported, certain columns may not fall into the order as it is in the macro. Is there anyway to have the macro search a file being imported based on the name of the column header i.e if the column header is "Problem Summary" or "Subject", place column in B or if column header is "Create Date" or "Request Date" import column into Column H. Below I have the current code as well as the report in which the macro is running (press import button on 'Menu' tab to import file into "Import" tab).
Report.xlsx
emc-ticket-history-view-2015-03-31-1432.
Sample-Report.xlsx
Sub Select_File_Or_Files_Mac()
Dim MyPath As String
Dim MyScript As String
Dim MyFiles As String
Dim MySplit As Variant
Dim N As Long
Dim Fname As String
Dim mybook As Workbook
Dim filePath As Variant
Dim dataRange As Range 'Range in the import sheet to get data from (excludes header row)
Dim destRange As Range 'Range in the destination sheet to write to (end of usedrange.rows +1)
'On Error Resume Next
MyPath = MacScript("return (path to documents folder) as String")
MyScript = _
"set applescript's text item delimiters to "","" " & vbNewLine & _
"set theFiles to (choose file of type " & _
" {""com.microsoft.excel.xls"",""public.comma-separated-values-text"",""org.openxmlformats.spreadsheetml.sheet""}" & _
"with prompt ""Please select a file or files"" default location alias """ & _
MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
"set applescript's text item delimiters to """" " & vbNewLine & _
"return theFiles"
MyFiles = MacScript(MyScript)
On Error GoTo 0
If MyFiles <> "" Then
MySplit = Split(MyFiles, ",")
Set destRange = ThisWorkbook.Sheets("Import").UsedRange
'Clear content of Current sheet apart from headers
destRange.Offset(1).Clear
For Each filePath In MySplit
Set mybook = Application.Workbooks.Open(filePath, , True, , , , , , , , , , False) 'open read-only. Don't add to MRU
testval = mybook.Sheets(1).Cells(1, 1).Value 'Check the value of cell A1 to determine the version of the import sheet
Debug.Print testval
Set dataRange = mybook.Sheets(1).UsedRange.Offset(1)
Set dataRange = dataRange.Resize(dataRange.Rows.Count - 1)
Debug.Print dataRange.Address
Set destRange = ThisWorkbook.Sheets("Import").UsedRange
'Clear content of Current sheet apart from headers
' If testval = "SR Number" Or testval = "ID" Then
' destRange.Offset(1).Clear
' Set destRange = destRange.Resize(1, 1)
' End If
If testval = "Subject" Or testval = "Problem Summary" Then
destRange.Offset(2).Clear
Set destRange = destRange.Resize(2, 2)
End If
Set destRange = destRange.Offset(destRange.Rows.Count).Resize(dataRange.Rows.Count)
Debug.Print destRange.Address
If testval = "id" Then 'ge-ticket-history-view-2015-03-31' (Zendesk file type)
destRange.Columns(1).Value = dataRange.Columns(1).Value 'SR
destRange.Columns(2).Value = dataRange.Columns(3).Value 'Subject
destRange.Columns(3).Value = dataRange.Columns(4).Value 'Severity
destRange.Columns(4).Value = dataRange.Columns(6).Value 'Assignee
destRange.Columns(5).Value = dataRange.Columns(2).Value 'Status
destRange.Columns(6).Value = dataRange.Columns(5).Value 'Product
destRange.Columns(7).Value = dataRange.Columns(7).Value 'Organization
destRange.Columns(8).Value = dataRange.Columns(8).Value 'Request Date
destRange.Columns(9).Value = dataRange.Columns(9).Value 'LastUpdated
destRange.Columns(10).Value = Now()
ElseIf testval = "SR Number" Then 'SEARCH-SR-PRODUCT-GROUPS (EMC Support file type)
destRange.Columns(1).Value = dataRange.Columns(1).Value 'SR
destRange.Columns(2).Value = dataRange.Columns(2).Value 'Problem Summary
destRange.Columns(3).Value = dataRange.Columns(3).Value 'Severity
destRange.Columns(4).Value = dataRange.Columns(4).Value 'Owner
destRange.Columns(5).Value = dataRange.Columns(5).Value 'Status
destRange.Columns(6).Value = dataRange.Columns(7).Value 'Product
destRange.Columns(7).Value = dataRange.Columns(8).Value 'Organization
destRange.Columns(8).Value = dataRange.Columns(10).Value 'Create Date
destRange.Columns(9).Value = dataRange.Columns(11).Value 'LastUpdated
For Each c In destRange.Columns(8).Cells
c.Value = ISODateToExcel(c.Value)
Next
destRange.Columns(10).Value = Now()
ElseIf testval = "" Then 'US Bank (import file type)
destRange.Columns(1).Value = dataRange.Columns(2).Value 'SR
destRange.Columns(2).Value = dataRange.Columns(10).Value 'Subject
destRange.Columns(3).Value = dataRange.Columns(6).Value 'Severity
destRange.Columns(4).Value = dataRange.Columns(12).Value 'Owner
destRange.Columns(5).Value = dataRange.Columns(11).Value 'Status
destRange.Columns(6).Value = dataRange.Columns(8).Value 'Product
destRange.Columns(7).Value = dataRange.Columns(4).Value 'Organization
destRange.Columns(8).Value = dataRange.Columns(14).Value 'Creation Date
destRange.Columns(9).Value = dataRange.Columns(16).Value 'LastUpdated
destRange.Columns(10).Value = Now()
End If
mybook.Close
Next
End If
End Sub
Function ISODateToExcel(DTString) As Date
thedate = DateSerial(Left(DTString, 4), Mid(DTString, 6, 2), Mid(DTString, 9, 2))
thetime = TimeSerial(Mid(DTString, 12, 2), Mid(DTString, 15, 2), Mid(DTString, 18, 2))
ISODateToExcel = thedate + thetime
End Function
Report.xlsx
emc-ticket-history-view-2015-03-31-1432.
Sample-Report.xlsx
Martin Liss
Where did I go wrong? I opened DSE-Carelog-Report and clicked the 'Import Report File(s)' button. Tracing the code, it figured out that it was running in Windows (although I'm actually on a MAC using Parallels to create a Windows VM) and it took me to Select_File_Or_Files_Windo
ASKER
I haven't not configured the macro that calls the windows version due to the fact that the reporting tool is currently being built for mostly support engineers that are Mac users. Once that is configured roughly is when I'll map it over for windows users.
OK, sorry but in that case I can't help.
ASKER
What I am trying to do is just have a macro read through a file that is being imported and recognize the name of a column header and where to place that column within another sheet. This column header for some of the files that may be imported (into the 'Import' tab with command button on 'Menu' tab) may be different so a if statement would be ideal to differentiate the column headers and place them appropriately in the 'Current' tab based on this criteria.
I don't fully understand what you are saying so let's take it step by step.
In the file you provided I assume the first line shown here
id,Status,Subject,Severity
is the headings. I also see that in the 'Current' sheet you have headings that are similar to, but not always exactly the same as the headings in the data. Do you want to copy the data to each of those worksheet columns? In other words Severity to Severity, Assignee to Owner/Assignee, etc.
Are the individual names in the data always the same? In other words is Assignee always Assignee?
In the file you provided I assume the first line shown here
id,Status,Subject,Severity
is the headings. I also see that in the 'Current' sheet you have headings that are similar to, but not always exactly the same as the headings in the data. Do you want to copy the data to each of those worksheet columns? In other words Severity to Severity, Assignee to Owner/Assignee, etc.
Are the individual names in the data always the same? In other words is Assignee always Assignee?
ASKER
Yes. The main thing is that if you look at the other files, they all have different headers that mean the same thing. Ideally, the macro would recognize any file that is imported based on the column headers and appropriately align them in the 'Import' tab as it already does. For instance, in one file, Assignee will be Assignee but in other it might be Owner. If the macro is able to have a criteria to fit the differences in some of the column headers, that would work great. Those three files are from the three platforms that the user can pull the report from. Those fields for each will remain the same in each file and I wanted to standardize each field in the "Current" tab which is why you see "Assignee/Owner".
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thank you for significant input on this inquiry. Attached is the report with the possible headers for a import file. Will the macro test these in the header tab and display the message box as you said it would as it relates to the current sheet once matched? If so, then I feel that this accomplished what I was looking for.
ASKER
Here is the reporting tool with the headers field filled out. Just wanted to confirm that this is what the macro will test.
DSE-Carelog-Report.xlsm
DSE-Carelog-Report.xlsm
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Okay I understand and Channel is for another field I am adding which will come after Date Imported and before SR Status Update called "Create Method". To clarify, once this code is converted to MAC, it should input all the headers for the import filed and also still have previous headers saved for familiarity? These headers would be saved in Header Relationship tab for anytime I import a file to know where to place it in the 'Current' tab is what I am taking away from this. Correct me if I am wrong.
You are correct.
I'm glad I was able to help.
In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2014
In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2014
ASKER
Thank you. Looking to convert the code to MAC now and I will look into your profile as well.
ASKER
Would you know of a expert that can assist with this conversion?
No I don't but except for opening the file which looks like you already know how to do, I assume the VBA would be the same. But don't do anything yet. I've found a change or two that should be made and I'll get back to you with those changes soon.
Here's an updated Windows sub.
Changes:
Rows 14 to 17
Changed intWhere (and it's name) to a Variant so that it could be used to test whether or not the user pressed Cancel from the InputBox.
Added intLastRow for use in validation
Line 29
Added to count the number of used rows in column B
Line 35 Commented out because it's not needed.
Lines 38 to 52
Improved the code to include a check for Cancel being pressed and to make sure that a valid column number was entered.
Line 61
Let the user know that he's done.
One other thing you might do is to add a new row 14 on the Header Relationships sheet with A14 = "Future" or "Not Used" or even blank because the value isn't used, and B14 = "13". That way you can respond "13" to the inputbox when it asks what to do with Channel or any other value that isn't set up yet, and you won't be asked about it again unless you manually clear B14.
Sub Select_File_Or_Files_Windows()
Dim SaveDriveDir As String
Dim MyPath As String
Dim Fname As Variant
Dim N As Long
Dim FnameInLoop As String
Dim mybook As Workbook
Dim FF As Integer
Dim strLine As String
Dim strparts() As String
Dim lngIndex As Long
Dim rngFound As Range
'New
' Dim intWhere As Integer
Dim varWhere As Variant
Dim intLastRow As Integer
Dim intLastCol As Integer
FF = FreeFile
Open "C:\safari downloads\Q_28647896.csv" For Input As #FF ' Change as needed
Line Input #FF, strLine
strparts = Split(strLine, ",")
Close
'new
intLastRow = Sheets("Header Relationships").Cells(Rows.Count, 1).End(xlUp).Row
For lngIndex = 0 To UBound(strparts)
With Sheets("Header Relationships").UsedRange
Set rngFound = .Find(What:=strparts(lngIndex), LookIn:=xlValues)
If Not rngFound Is Nothing Then
'MsgBox "Data heading '" & strparts(lngIndex) & "' goes in column " & .Cells(rngFound.Row, 2)
Else
'new
' varWhere = InputBox("Please enter the column number of the Current sheet that should " _
& "be associated with the data file column named '" & strparts(lngIndex) & "'")
Do Until Val(varWhere) > 0 And Val(varWhere) <= .Cells(intLastRow, 2)
varWhere = InputBox("Please enter the column number of the Current sheet that should " _
& "be associated with the data file column named '" & strparts(lngIndex) & "'")
' Check to see in the user clicls 'Cancel'
If StrPtr(varWhere) = 0 Then
MsgBox "Cancelling the Import"
Exit Sub
End If
' Make sure value is a valid column number
If Val(varWhere) < 1 Or Val(varWhere) > .Cells(intLastRow, 2) Then
MsgBox "Column number must be between 1 and " & .Cells(intLastRow, 2)
End If
Loop
intLastCol = .Cells(varWhere + 1, 1).End(xlToRight).Column
.Cells(varWhere + 1, intLastCol + 1) = strparts(lngIndex)
End If
End With
Next
'new
MsgBox "Import completed"
End SubChanges:
Rows 14 to 17
Changed intWhere (and it's name) to a Variant so that it could be used to test whether or not the user pressed Cancel from the InputBox.
Added intLastRow for use in validation
Line 29
Added to count the number of used rows in column B
Line 35 Commented out because it's not needed.
Lines 38 to 52
Improved the code to include a check for Cancel being pressed and to make sure that a valid column number was entered.
Line 61
Let the user know that he's done.
One other thing you might do is to add a new row 14 on the Header Relationships sheet with A14 = "Future" or "Not Used" or even blank because the value isn't used, and B14 = "13". That way you can respond "13" to the inputbox when it asks what to do with Channel or any other value that isn't set up yet, and you won't be asked about it again unless you manually clear B14.
In addition to the above, see this for a list of MAC VBA differences.
ASKER
Two things. I've attached a picture of what I've done pertaining to adding a new row in the Header Relationships sheet. I've added the Channel row where I will most likely pull in into the report as well as the suggested entry of a future column. Just wanted confirm that I did this correctly. In addition, I am receiving a error now about the path when I run it on a Windows interface. Any help here?
Error-Message.PNG
Sub Select_File_Or_Files_Windows()
Dim SaveDriveDir As String
Dim MyPath As String
Dim Fname As Variant
Dim N As Long
Dim FnameInLoop As String
Dim mybook As Workbook
Dim FF As Integer
Dim strLine As String
Dim strparts() As String
Dim lngIndex As Long
Dim rngFound As Range
'New
' Dim intWhere As Integer
Dim varWhere As Variant
Dim intLastRow As Integer
Dim intLastCol As Integer
FF = FreeFile
Open "C:\Users\kippa\Downloads" For Input As #FF ' Change as needed
Line Input #FF, strLine
strparts = Split(strLine, ",")
Close
'new
intLastRow = Sheets("Header Relationships").Cells(Rows.Count, 1).End(xlUp).Row
For lngIndex = 0 To UBound(strparts)
With Sheets("Header Relationships").UsedRange
Set rngFound = .Find(What:=strparts(lngIndex), LookIn:=xlValues)
If Not rngFound Is Nothing Then
'MsgBox "Data heading '" & strparts(lngIndex) & "' goes in column " & .Cells(rngFound.Row, 2)
Else
'new
' varWhere = InputBox("Please enter the column number of the Current sheet that should " _
& "be associated with the data file column named '" & strparts(lngIndex) & "'")
Do Until Val(varWhere) > 0 And Val(varWhere) <= .Cells(intLastRow, 2)
varWhere = InputBox("Please enter the column number of the Current sheet that should " _
& "be associated with the data file column named '" & strparts(lngIndex) & "'")
' Check to see in the user clicls 'Cancel'
If StrPtr(varWhere) = 0 Then
MsgBox "Cancelling the Import"
Exit Sub
End If
' Make sure value is a valid column number
If Val(varWhere) < 1 Or Val(varWhere) > .Cells(intLastRow, 2) Then
MsgBox "Column number must be between 1 and " & .Cells(intLastRow, 2)
End If
Loop
intLastCol = .Cells(varWhere + 1, 1).End(xlToRight).Column
.Cells(varWhere + 1, intLastCol + 1) = strparts(lngIndex)
End If
End With
Next
'new
MsgBox "Import completed"
End SubError-Message.PNG
The sheet looks right.
Your Open "C:\Users\kippa\Downloads"
Open "C:\safari downloads\Q_28647896.csv" For Input As #FF
where Q_28647896.csv is the file name.
Your Open "C:\Users\kippa\Downloads"
Open "C:\safari downloads\Q_28647896.csv" For Input As #FF
where Q_28647896.csv is the file name.
ASKER
Okay it is working now but everytime it asks me about the column associated with "id" and I type 1, it tells me to enter a number between 1 and. Any suggestions on this last issue?
I'm busy right now but I'll have a fix by the morning. Sorry I didn't test that condition.
I can't reproduce the error you are getting. The line that validates the input is If Val(varWhere) < 1 Or Val(varWhere) > .Cells(intLastRow, 2) Then and what that is saying is that if the numerical value of the input is less than 1 or the numerical value of the input is greater than the value in the last row of column B then it's an error. So I can only see a couple of possibilities and they are that perhaps rather than copy/pasting my code you typed in it and you made a mistake somewhere, or you didn't actually enter 1 but rather 0 or an alphanumeric character.
Try changing the error message from
MsgBox "Column number must be between 1 and " & .Cells(intLastRow, 2)
to
MsgBox "You entered '" & varWhere & "' and column number must be between 1 and " _
& .Cells(intLastRow, 2) & ". Please try again."
That might help you (or your users) see what's wrong. If that doesn't work then please attach your workbook that includes the implementation of my code.
Try changing the error message from
MsgBox "Column number must be between 1 and " & .Cells(intLastRow, 2)
to
MsgBox "You entered '" & varWhere & "' and column number must be between 1 and " _
& .Cells(intLastRow, 2) & ". Please try again."
That might help you (or your users) see what's wrong. If that doesn't work then please attach your workbook that includes the implementation of my code.
ASKER
Attached is the error message I am getting along with the reporting tool that has the updated macro in it. Would it be possible to not use a direct file and have the user be prompted to import a file?
Error-Message.png
Sub Select_File_Or_Files_Windows()
Dim SaveDriveDir As String
Dim MyPath As String
Dim Fname As Variant
Dim N As Long
Dim FnameInLoop As String
Dim mybook As Workbook
Dim FF As Integer
Dim strLine As String
Dim strparts() As String
Dim lngIndex As Long
Dim rngFound As Range
'New
' Dim intWhere As Integer
Dim varWhere As Variant
Dim intLastRow As Integer
Dim intLastCol As Integer
FF = FreeFile
Open "C:\Users\kippa\Downloads\emc-ticket-history-view-2015-03-31-1432.csv" For Input As #FF ' Change as needed
Line Input #FF, strLine
strparts = Split(strLine, ",")
Close
'new
intLastRow = Sheets("Header Relationships").Cells(Rows.Count, 1).End(xlUp).Row
For lngIndex = 0 To UBound(strparts)
With Sheets("Header Relationships").UsedRange
Set rngFound = .Find(What:=strparts(lngIndex), LookIn:=xlValues)
If Not rngFound Is Nothing Then
'MsgBox "Data heading '" & strparts(lngIndex) & "' goes in column " & .Cells(rngFound.Row, 2)
Else
'new
' varWhere = InputBox("Please enter the column number of the Current sheet that should " _
& "be associated with the data file column named '" & strparts(lngIndex) & "'")
Do Until Val(varWhere) > 0 And Val(varWhere) <= .Cells(intLastRow, 2)
varWhere = InputBox("Please enter the column number of the Current sheet that should " _
& "be associated with the data file column named '" & strparts(lngIndex) & "'")
' Check to see in the user clicks 'Cancel'
If StrPtr(varWhere) = 0 Then
MsgBox "Cancelling the Import"
Exit Sub
End If
' Make sure value is a valid column number
If Val(varWhere) < 1 Or Val(varWhere) > .Cells(intLastRow, 2) Then
MsgBox "You entered '" & varWhere & "' and column number must be between 1 and " & .Cells(intLastRow, 2) & ". Please try again."
End If
Loop
intLastCol = .Cells(varWhere + 1, 1).End(xlToRight).Column
.Cells(varWhere + 1, intLastCol + 1) = strparts(lngIndex)
End If
End With
Next
'new
MsgBox "Import completed"
End SubError-Message.png
Yes the program could be changed to have the user select a file but let's fix the "1" problem first. The problem for me is that I can't make it fail! I tried 1 with a space following it, a 1 with a space preceding it, and even the number keypad 1 and they all work just fine.
I did find that varWhere = "" should be added right before line 39 but I don't think that is causing your problem.
Please tell me exactly, step by step including going to any particular page in the workbook, what you did just prior to starting the import. Also and I don't see how this could be causing the problem, but please attach the file you are currently trying to import if it's different or changed from the one you posted originally.
I did find that varWhere = "" should be added right before line 39 but I don't think that is causing your problem.
Please tell me exactly, step by step including going to any particular page in the workbook, what you did just prior to starting the import. Also and I don't see how this could be causing the problem, but please attach the file you are currently trying to import if it's different or changed from the one you posted originally.
ASKER
I restarted the program and started from the 'Menu' tab. I clicked on the "Import Report File(s) button and the dialog box pops up to enter the column number of the 'Current' Sheet that's associated and I type "1" being that "id" is the first column in both the file being imported and the 'Current' worksheet. Not sure why it isn't moving on to the next column but I keep getting a error message. Attached is the file I am currently trying to import.
emc-ticket-history-view-2015-03-27-1537.
emc-ticket-history-view-2015-03-27-1537.
Are you doing this from a Windows environment?
ASKER
Yes, I am working on my MAC for the OS environment as well as my Thinkpad Lenovo for the Windows environment
And just to be clear, did this error occur on your Thinkpad?
Try changing
If Val(varWhere) < 1 Or Val(varWhere) > .Cells(intLastRow, 2) Then
to
If CInt(varWhere) < 1 Or CInt(varWhere) > .Cells(intLastRow, 2) Then
If Val(varWhere) < 1 Or Val(varWhere) > .Cells(intLastRow, 2) Then
to
If CInt(varWhere) < 1 Or CInt(varWhere) > .Cells(intLastRow, 2) Then
ASKER
Yea it is occurring on my Thinkpad and after switching those values, I get the same error.
I really don't know why you are getting the error but try this for me
1. Undo the change in post ID 40710746
2. Add Debug.Print "Entered: " & Asc(varWhere) following the If Val(varWhere) < 1 Or Val(varWhere) > .Cells(intLastRow, 2) Then line.
3. When the error occurs, cancel the import and go to the Visual Basic environment and look at the Immediate Window (ctrl+g) and tell me what it says. It should be something like
Entered: 49
1. Undo the change in post ID 40710746
2. Add Debug.Print "Entered: " & Asc(varWhere) following the If Val(varWhere) < 1 Or Val(varWhere) > .Cells(intLastRow, 2) Then line.
3. When the error occurs, cancel the import and go to the Visual Basic environment and look at the Immediate Window (ctrl+g) and tell me what it says. It should be something like
Entered: 49
While out of curiosity I'd still like to know what the Debug.print statement shows, I've come up with what I believe is a better method that avoids the problem altogether. So try the attached and hopefully it will work for you.
Q-28647896.xlsm
Q-28647896.xlsm