• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Request for VBA code

Bassam Omar

New Member
Hi,
I appreciate your efforts helping people.
I'm not experienced in dealing with macros and Excel vba codes, but i'm in
great need of a code doing the following:

I've an excel sheet similar to:

A B C D E F

1 NAME1 NAME2

2 DATE STATUS PROPERTY1 PROPERTY2 STATUS........................

3 1-1-013

4 2-1-013

5
.
.
.
31-12-013


and a database of files in c:\\users\username\desktop\2013

Named as follows

SGP-1-JAN-013
SGP-2-JAN-013
.
.
SGP-1-FEB-013
.
.
SGP-1-MAR-013



AND each workbook is something like this:

A B C D

1 NAME STATUS PROPERTY1 PROPERTY2

2

3

4


The problem is, as you can see, i need a code taking into account :

1- the variables in the referred workbook name ( day, month)
2- searching the reference worksheet for a matched name and property for
each cell and get the result copied. ex: the required code if run for
cell C3 the program should open the correct workbook considering the date
in A3 and matching the name ''NAME1'' and the word "status" to find
the similar cell and copy its value to C3 in the active worksheet, and so
on.


I know its very complicated, but i'm sure you can help me with that.

I hope i explained it well.



Thanks for your time.

Bassam Omar
 
Hi Omar ,

Thanks for the detailed explanation , but I , for one , find it difficult to visualize the problem fully.

Can you upload the Excel workbook which you mention in the beginning , and at least one of the files from the database ? Then , if others still have doubts , these can be asked with reference to your actual data.

Narayan
 
Thanks for your reply, Narayan. I really appreciate your effort trying to help.
I'll try to make it easier. The whole thing is about Copying values from cells in excel files in a known directory on a workplace network. What i need is a code that can understand which workbook to open and which cell to copy its value (According to the information of the active cell in the active workbook). I hope i made it clear this time.

Attached are files showing an example of what needed to be done.
 

Attachments

  • The Active Sheet.xlsx
    38.8 KB · Views: 1
  • SGP REPORT 14-JAN-13.xlsx
    18.6 KB · Views: 1
Bassam Omar,

In the sample files you attached, The Active Sheet.xlsx and SGP REPORT 14-JAN-13.xlsx, once the macro is run, the row number 18 should have data from 'Location Data'!B4:E4 in 'Sheet 1'!D18:G18, similary data from 'Location Data'!B5:E5 in 'Sheet 1'!L18:O18, so on and so forth. Correct?
 
Exactly, Sam. You got it right. And as you say, i want the macro or whatever the method we shall use to repeat this for every location in the specific date (say, 14-jan-013) and repeat all this for all days along the year (and i think this is the hard part, to make it open the right excel file according to the corresponding date).
 
So when you say every location for specific date, your master sheet only has 3 locations. From your post above, I am guessing you mean to say that there could be 'any' number of locations.
 
You are right, but it won't exceed 10 locations ( and by the way they have different names, not numbered ones as in the example).

First, i need the main code, and i'll see for any repetitions or problems that may arise, so let's start with what in hand ( I mean, consider the whole project is for 2months, say, and three locations).

And to take a look on how the files are named in the database (let's say it is in the directory
c:\\users\username\desktop\2013), See the attached screenshots.

Note: in the actual project, only the directory path is different but the names of the MONTHS folders and the EXCEL FILES are exactly the same as in the picture.
- Each file of these has similar format to what is shown in the previously attached file named " SGP REPORT 14-JAN-13 "
 

Attachments

  • Screenshot - 1.png
    Screenshot - 1.png
    50.6 KB · Views: 3
  • Screenshot - 2.png
    Screenshot - 2.png
    105.8 KB · Views: 3
Fair enough. So you'd like to start with the assumption that we just have 3 locations, and 2 months of data. And, yes the file name will be exactly SGP REPORT DD-MMM-YY.xlsx
 
Stumbled on a problem. Your folders are named by month. But some of them are in MMM format, and some in MMMM format. You'll need to keep this consistent. Either write Aug for August, Sep for September, OR write the entire name.
 
I know that's very complicated, but that's the problem. I am not the author of these files and i cann't change these names as it is stored on a network PC. If there is a way to overcome this, ok. If there isn't, thanks anyway for your time and i'm so sorry i got you exhausted.
 
Hmmm. Don't worry about my getting exhausted. Been doing this for some years now :)

Anyway, if you think the month names of the folders will either be MMM, or MMMM, ie. ex., Apr or April, or Feb or February, and not something inconsistent like Febr, or Sept, then I could still make the code check for availability of the month.
 
I'm saying that it will be difficult with inconsistent names. But if you can be sure that the month names will either be the entire month name, or the standard 3 letter short form, then I can at least hard code for those.
 
As i told you before, i am just a surfer of these files and in need of extracting these data out of them, so provide me with what you can achieve and take your time as i am probably not going to be able to reply messages for a week to come, but i am still waiting for assistance.
 
Bassam Omar,

Here's something that should take care of all the month's issues being inconsistent. The only assumption is that the name of the month will have at least 3 character, and that it will follow the order of the alphabets. For Ex. September can be anything from Sep, Sept, Septe, Septem, Septemb, Septembe, September. But NOT Septmbr, or Stmbr or anything of that sort. From the snapshot you've given, all the months comply to this assumption.

Another assumption is that there will only be one year's folder.

So that being said, here's an attempt to solve your request

Code:
Private Const mcstrFilePattern As String = "SGP REPORT ##-???-##.xlsx"
Private Const mcstrFileActual As String = "SGP REPORT DD-MMM-YY.xlsx"
Private Const mcstrFixedName As String = "SGP REPORT "
Private Const mcstrLookInFolder As String = "C:\Users\All Users\Desktop\" 'Ensure this ends with a "\"
Private Const mclngColumnsToCopy As Long = 4
Private Const mclngColumnsToJump As Long = 8

Sub SMC()

    Dim lngRowLoop          As Long
    Dim lngRowIndex         As Long
    Dim lngColLoop          As Long
    Dim lngCurrentMonth     As Long
    Dim lngDatesNotFound    As Long
    Dim strFile             As String
    Dim strCurrentFile      As String
    Dim strMonthFolderName  As String
    Dim strDatesNotFound    As String
    Dim wbkMaster           As Workbook
    Dim wbkDailyFile        As Workbook
    
    Set wbkMaster = Workbooks("The Active Sheet.xlsm")
    With wbkMaster.Sheets(1)
        For lngRowLoop = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row
            lngCurrentMonth = .Cells(lngRowLoop, 2).Value
            'If lngCurrentMonth <> 1 Then Stop
            strMonthFolderName = GetMonthFromFolder(mcstrLookInFolder, lngCurrentMonth)
            If strMonthFolderName <> "" Then
                strCurrentFile = Replace(mcstrFileActual, "DD-MMM-YY", Format(DateSerial(.Cells(lngRowLoop, 3).Value, .Cells(lngRowLoop, 2).Value, .Cells(lngRowLoop, 1).Value), "DD-MMM-YY"))
                strFile = Dir(mcstrLookInFolder & strMonthFolderName & strCurrentFile)
                If strFile <> "" Then
                    Set wbkDailyFile = Workbooks.Open(mcstrLookInFolder & strMonthFolderName & strCurrentFile, ReadOnly:=True)
                    For lngColLoop = 4 To .Cells(3, .Columns.Count).End(xlToLeft).Column Step mclngColumnsToJump
                        For lngRowIndex = 4 To wbkDailyFile.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
                            If wbkDailyFile.Sheets(1).Cells(lngRowIndex, 1).Value = .Cells(3, lngColLoop).Value Then
                                .Cells(lngRowLoop, lngColLoop).Resize(1, mclngColumnsToCopy).Value = wbkDailyFile.Sheets(1).Cells(lngRowIndex, 2).Resize(1, mclngColumnsToCopy).Value
                            End If
                        Next lngRowIndex
                    Next lngColLoop
                    wbkDailyFile.Close
                    Set wbkDailyFile = Nothing
                Else
                    lngDatesNotFound = lngDatesNotFound + 1
                    strDatesNotFound = strDatesNotFound & FormatDateTime(DateSerial(.Cells(lngRowLoop, 3).Value, .Cells(lngRowLoop, 2).Value, .Cells(lngRowLoop, 1).Value), vbLongDate) & vbLf
                End If
            Else
                lngDatesNotFound = lngDatesNotFound + 1
                strDatesNotFound = strDatesNotFound & FormatDateTime(DateSerial(.Cells(lngRowLoop, 3).Value, .Cells(lngRowLoop, 2).Value, .Cells(lngRowLoop, 1).Value), vbLongDate) & vbLf
            End If
        Next lngRowLoop
    End With
    If lngDatesNotFound Then
        If vbYes = MsgBox(lngDatesNotFound & " out of " & lngRowLoop - 5 & " dates couldn't be found. Do you want to see a list of those dates?", vbYesNo + vbQuestion, "") Then
            MsgBox "Missing dates are: " & vbLf & vbLf & strDatesNotFound, vbOKOnly, ""
        End If
    End If
    
End Sub

Function GetMonthFromFolder(strLookInFolder As String, lngCurrentMonth As Long) As String

    Dim lngChar As Long
    Dim strMonth As String
    Dim strUseMonth As String
    
    strMonth = MonthName(lngCurrentMonth)
    For lngChar = Len(strMonth) To 3 Step -1
        strUseMonth = Dir(strLookInFolder & Mid(strMonth, 1, lngChar), vbDirectory)
        If Len(strUseMonth) Then
            If Len(Dir(strLookInFolder & strUseMonth & "\" & mcstrFixedName & "*.xlsx")) Then
                GetMonthFromFolder = strUseMonth & "\"
                Exit For
            End If
        End If
    Next lngChar
    
End Function
 
Back
Top