View Full Version : Need help creating a loop macro that spits out a master data file
iraos
12-27-2013, 10:39 AM
Hi,
I have a macro that runs through an excel file and comes up with values. The only thing is that I have 100s of files that need to be analyzed. I was wondering if any one had a loop macro that can be added onto my macro so that it can run through the files in the folder and create a master database with the variables I need.
I am new to this so any help would be appreciated!
I have attached the macro that I have
11007
Thanks!
@ All: The Docx attachment is only the code in question pasted into Word. The code is below.
@ Iraos: Welcome to VBAExpress. Please take the time to read the FAQ link in my signature. Thanks.
In the future, you can just copy the code in the VBA and paste it inot your post by clicking the # icon in the Post Editor and pasting the code in between the Code Tags that appear. Or you can paste the code, then select it, then click the icon. I have done that for you in
this post.
Sub Face_Task()
' shortcut: ctrl + t
'
' Face_Task Macro
' 1) keeps track of the number correct in each condition and then calculates
' the percentage correct in each condition
' 2) the mean reaction time (RT) for each condition, which should be calculated
' as the sum of the RTs only for correct responses in each condition divided
' by the number correct in that condition
'
Dim dataHolderH(2) 'An array that holds the correct
Dim dataHolderB(2) 'number, the total number, and
Dim dataHolderL(2) 'the total RT
Dim inputResponse As String 'Temp variables for each row
Dim gender As String
Dim correct As Boolean
Dim displayType As String
Dim reactTime As Double
Range("A2").Select 'go to A2 and start from there
Do While (1)
If ActiveCell.Value <> "" Then 'if the current value isn't empty then we need to process the whole row
ActiveCell.Offset(0, 2).Select
inputResponse = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
reactTime = ActiveCell.Value
ActiveCell.Offset(0, 2).Select
gender = ActiveCell.Value
correct = (inputResponse = "male" And gender = "m") Or (inputResponse = "female" And gender = "f")
ActiveCell.Offset(0, 1).Select
displayType = ActiveCell.Value
If displayType = "h" Then
dataHolderH(0) = dataHolderH(0) + Abs(correct) 'number of correct
dataHolderH(1) = dataHolderH(1) + 1 'total number
If correct Then
dataHolderH(2) = dataHolderH(2) + reactTime 'total reaction time of correct trials
End If
ElseIf displayType = "b" Then
dataHolderB(0) = dataHolderB(0) + Abs(correct) 'Abs is a function to get the absolute value of the boolean variable
dataHolderB(1) = dataHolderB(1) + 1
If correct Then
dataHolderB(2) = dataHolderB(2) + reactTime 'total reaction time of correct trials
End If
ElseIf displayType = "l" Then
dataHolderL(0) = dataHolderL(0) + Abs(correct)
dataHolderL(1) = dataHolderL(1) + 1
If correct Then
dataHolderL(2) = dataHolderL(2) + reactTime 'total reaction time of correct trials
End If
End If
ActiveCell.Offset(1, -6).Select
Else 'if the current value is empty then render result
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = "Result: "
Selection.Font.Bold = True
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = "Display Type"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "High"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Broad"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Low"
Selection.Font.Bold = True
ActiveCell.Offset(1, -3).Select
ActiveCell.Value = "Correct Number"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = dataHolderH(0)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = dataHolderB(0)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = dataHolderL(0)
ActiveCell.Offset(1, -3).Select
ActiveCell.Value = "Total Number"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = dataHolderH(1)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = dataHolderB(1)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = dataHolderL(1)
ActiveCell.Offset(1, -3).Select
ActiveCell.Value = "Correct Ratio"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = dataHolderH(0) / dataHolderH(1)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = dataHolderB(0) / dataHolderB(1)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = dataHolderL(0) / dataHolderL(1)
ActiveCell.Offset(1, -3).Select
ActiveCell.Value = "Total RT"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = dataHolderH(2)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = dataHolderB(2)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = dataHolderL(2)
ActiveCell.Offset(1, -3).Select
ActiveCell.Value = "Mean RT"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = dataHolderH(2) / dataHolderH(0)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = dataHolderB(2) / dataHolderB(0)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = dataHolderL(2) / dataHolderL(0)
Exit Do
End If
Loop
End Sub
'
'
'
Uplaod a workbook showing exactly what text values Range("A2:G10") should contain after the code is run. I already have 1/2 hour into documenting the code just to add cell reference comments to it and already hound at least one mistake I made then.
I HATE
ActiveCell.Offset(1, 0).Select
ActiveCell.Value =
REPEATED A ZILLION TIMES
Don't ever do that again :whip :bat2:
Here are the cell assignments. I think :dunno
Do While (1)
If ActiveCell.Value <> "" Then 'A2
ActiveCell.Offset(0, 2).Select 'c2
inputResponse = ActiveCell.Value
ActiveCell.Offset(0, 1).Select 'd2
reactTime = ActiveCell.Value
ActiveCell.Offset(0, 2).Select 'f2
gender = ActiveCell.Value
CorrectInput = (inputResponse = "male" And gender = "m") Or (inputResponse = "female" And gender = "f")
ActiveCell.Offset(0, 1).Select 'g2
displayType = ActiveCell.Value
If displayType = "h" Then
dataHolderH(0) = dataHolderH(0) + Abs(CorrectInput)
dataHolderH(1) = dataHolderH(1) + 1
If CorrectInput Then
dataHolderH(2) = dataHolderH(2) + reactTime
End If
ElseIf displayType = "b" Then
dataHolderB(0) = dataHolderB(0) + Abs(CorrectInput)
dataHolderB(1) = dataHolderB(1) + 1
If CorrectInput Then
dataHolderB(2) = dataHolderB(2) + reactTime
End If
ElseIf displayType = "l" Then
dataHolderL(0) = dataHolderL(0) + Abs(CorrectInput)
dataHolderL(1) = dataHolderL(1) + 1
If CorrectInput Then
dataHolderL(2) = dataHolderL(2) + reactTime
End If
End If
ActiveCell.Offset(1, -6).Select 'a3
Else
ActiveCell.Offset(1, 0).Select 'a4
ActiveCell.Value = "Result: "
Selection.Font.Bold = True
ActiveCell.Offset(1, 0).Select 'a5
ActiveCell.Value = "Display Type"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select 'b5
ActiveCell.Value = "High"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select 'c5
ActiveCell.Value = "Broad"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select 'd5
ActiveCell.Value = "Low"
Selection.Font.Bold = True
ActiveCell.Offset(1, -3).Select 'a6
ActiveCell.Value = "CorrectInput Number"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select 'b6
ActiveCell.Value = dataHolderH(0)
ActiveCell.Offset(0, 1).Select 'c6
ActiveCell.Value = dataHolderB(0)
ActiveCell.Offset(0, 1).Select 'd6
ActiveCell.Value = dataHolderL(0)
ActiveCell.Offset(1, -3).Select 'a7
ActiveCell.Value = "Total Number"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select 'b7
ActiveCell.Value = dataHolderH(1)
ActiveCell.Offset(0, 1).Select 'c7
ActiveCell.Value = dataHolderB(1)
ActiveCell.Offset(0, 1).Select 'e7
ActiveCell.Value = dataHolderL(1)
ActiveCell.Offset(1, -3).Select 'b8
ActiveCell.Value = "CorrectInput Ratio"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select 'c8
ActiveCell.Value = dataHolderH(0) / dataHolderH(1)
ActiveCell.Offset(0, 1).Select 'd8
ActiveCell.Value = dataHolderB(0) / dataHolderB(1)
ActiveCell.Offset(0, 1).Select 'e8
ActiveCell.Value = dataHolderL(0) / dataHolderL(1)
ActiveCell.Offset(1, -3).Select 'b9
ActiveCell.Value = "Total RT"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select 'c9
ActiveCell.Value = dataHolderH(2)
ActiveCell.Offset(0, 1).Select 'd9
ActiveCell.Value = dataHolderB(2)
ActiveCell.Offset(0, 1).Select 'e9
ActiveCell.Value = dataHolderL(2)
ActiveCell.Offset(1, -3).Select 'b10
ActiveCell.Value = "Mean RT"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select 'c10
ActiveCell.Value = dataHolderH(2) / dataHolderH(0)
ActiveCell.Offset(0, 1).Select 'd10
ActiveCell.Value = dataHolderB(2) / dataHolderB(0)
ActiveCell.Offset(0, 1).Select 'e10
ActiveCell.Value = dataHolderL(2) / dataHolderL(0)
Exit Do
End If
Loop
End Sub
Dim dataHolderH(2) 'An array that holds the CorrectInput
Dim dataHolderB(2) 'number, the total number, and
Dim dataHolderL(2) 'the total RT
'Arrays' values = (0)Total Correct Inputs, (1)Total Inputs, (2)Total React Time
I'm going to post information about your code as I figure it out, for the sake of anyone else who wants to help you.
Your coding and commenting style is really atrocious. That is completely understandable when one is first learning to program. Hopefully we will expose you to coding styles that are more conducive to speed and readability. As you continue to learn programming, you will start to develop your own good style(s.)
Eadier to read AND removes a (slower) Function call
If (inputResponse = "male" And gender = "m") _
Or (inputResponse = "female" And gender = "f") _
Then CorrectInput = 1
The main If...Then...Else Algorithm is
If Starting Cell is empty Then
Get certain Values
Else
Paste certain values.
@iraos,
It's starting to look as if you need to loop thru each excel Workbook over many Ranges and extract data many times.
Is that correct?
It will help us a lot if you can upload a workbook with two sheets in it.
sheet1 should be a set of sample data and sheet2 should be an example of how you want the result to look like, using the sample data.
@ iraos,
I have refactored your code down as far as indicated. I stopped there because I am very uncertain of how you want the code to make the report about all the workbooks.
Remember just the names I used above the Sub, then study the refactored code and see how much easier it is to understand what is happening
Option Explicit
Private Enum CN_ColumnNumbersAsnames 'iraos: A set of Constants
cnInputResponse = 3
cnReactTime = 4
cnGender = 6
cnDisplayType = 7
End Enum
Private Type DataHolder 'iraos: A User Defined Type, (UDT.) See Type Statement in VBA Help
TotalInputs As Long 'iraos: each of these named parts can hold different Value Types
TotalCorrectInputs As Long
TotalReactTime As Double 'iraos: I am guessing what the actual value type for this is.
End Type
'Coders Note: Global variables for ease of use among and between various procedures 'iraos: Tells Why Global
Private DisplayTypeH As DataHolder 'Declaring a Variable as the UDT Type
Private DisplayTypeB As DataHolder
Private DisplayTypeL As DataHolder
'iraos: refer to any member with dot notation
'Example: DisplayTypeH.TotalInputs.
Sub Face_Task()
' shortcut: ctrl + t
'
' Face_Task Macro
' 1) keeps track of the number CorrectInput in each condition and then calculates
' the percentage CorrectInput in each condition
' 2) the mean reaction time (RT) for each condition, which should be calculated
' as the sum of the RTs only for CorrectInput responses in each condition divided
' by the number CorrectInput in that condition
'
Dim CorrectInput As Long
Dim Rw As Long
Rw = 2
Do While Cells(Rw, 1) <> "" 'iraos: Loop Thru every Row until Column A is empty
If (LCase(Cells(Rw, cnInputResponse)) = "male" And LCase(Cells(Rw, cnGender) = "m")) _
Or (LCase(Cells(Rw, cnInputResponse) = "female" And LCase(Cells(Rw, cnGender)) = "f")) _
Then CorrectInput = 1
Select Case LCase(Cells(Rw, cnDisplayType).Value)
Case "h"
'iraos: all dot members inside the With block belong to the ["With" Variable name]
With DisplayTypeH 'iraos: A UDT Type Variable. Each member is assigned a different value.
.TotalInputs = .TotalInputs + 1
.TotalCorrectInputs = .TotalCorrectInputs + CorrectInput
.TotalReactTime = .TotalReactTime + Cells(Rw, cnReactTime)
End With
Case "b"
With DisplayTypeB
.TotalInputs = .TotalInputs + 1
.TotalCorrectInputs = .TotalCorrectInputs + CorrectInput
.TotalReactTime = .TotalReactTime + Cells(Rw, cnReactTime)
End With
Case "l"
With DisplayTypeL
.TotalInputs = .TotalInputs + 1
.TotalCorrectInputs = .TotalCorrectInputs + CorrectInput
.TotalReactTime = .TotalReactTime + Cells(Rw, cnReactTime)
End With
End Select
Rw = Rw + 1
Loop
'iraos: Note that we have looped thru the entire block of data above the first empty cell in column "A", and Rw is now
'equal to the Row number just below the data.
'iraos: Refactoring stops here The next line is not refactored. It is here so you can find it in your original code.
ActiveCell.Offset(1, -6).Select 'a3
I have refactored the part that puts the data on a worksheet. I wrote it as a stand alone sub until we know exactly what you need.
Note that there are no Magic Numbers in the code. This makes it extremely easy to change the layout of the Report Table. For example, right now the columns are labled "high, Broad, low". If you boss decides he wants to see "Broad, Low, High," you only have to change 3 number charcters in the entire code. Likewise, he s/he wants to see "Mean RT" at the top of the table, you will only have to Cut and Paste two sections of the code.
Sub InsertDataTable(WkBk As Workbook, WkSht As Worksheet, StartCell As Range)
'7 Rows x 4 Columns
'Uses Modular level Variables
' DisplayTypeH
' DisplayTypeB
' DisplayTypeL
'Offset Values As Names
Const Label As Long = 0
Const H As Long = 1
Const B As Long = 2
Const L As Long = 3
Dim Rw As Long 'Row Offset Selector
With WkBk.Sheets(WkSht)
With StartCell
.Value = "Result: "
.Font.Bold = True
End With
Rw = Rw + 1
With .Offset(Rw, Label)
.Value = "Display Type"
.Font.Bold = True
End With
With .Offset(Rw, H)
.Value = "High"
.Font.Bold = True
End With
With .Offset(Rw, B)
.Value = "Broad"
.Font.Bold = True
End With
With .Offset(Rw, L)
.Value = "Low"
.Font.Bold = True
End With
Rw = Rw + 1
With .Offset(Rw, -Label)
.Value = "CorrectInput Number"
.Font.Bold = True
End With
.Offset(Rw, H).Value = DisplayTypeH.TotalCorrectInputs
.Offset(Rw, B).Value = DisplayTypeB.TotalCorrectInputs
.Offset(Rw, L).Value = DisplayTypeL.TotalCorrectInputs
Rw = Rw + 1
With .Offset(Rw, -Label)
.Value = "Total Number"
.Font.Bold = True
End With
.Offset(Rw, H).Value = DisplayTypeH.TotalInputs
.Offset(Rw, B).Value = DisplayTypeB.TotalInputs
.Offset(Rw, L).Value = DisplayTypeL.TotalInputs
Rw = Rw + 1
With .Offset(Rw, Label)
.Value = "CorrectInput Ratio"
.Font.Bold = True
End With
.Offset(Rw, H).Value = DisplayTypeH.TotalCorrectInputs / DisplayTypeH.TotalInputs
.Offset(Rw, B).Value = DisplayTypeB.TotalCorrectInputs / DisplayTypeB.TotalInputs
.Offset(Rw, L).Value = DisplayTypeL.TotalCorrectInputs / DisplayTypeL.TotalInputs
Rw = Rw + 1
With .Offset(Rw, Label)
.Value = "Total RT"
.Font.Bold = True
End With
.Offset(Rw, H).Value = DisplayTypeH.TotalReactTime
.Offset(Rw, B).Value = DisplayTypeB.TotalReactTime
.Offset(Rw, L).Value = DisplayTypeL.TotalReactTime
Rw = Rw + 1
With .Offset(Rw, Label)
.Value = "Mean RT"
.Font.Bold = True
End With
.Offset(Rw, H).Value = DisplayTypeH.TotalReactTime / DisplayTypeH(Rw)
.Offset(Rw, B).Value = DisplayTypeB.TotalReactTime / DisplayTypeB(Rw)
.Offset(Rw, L).Value = DisplayTypeL.TotalReactTime / DisplayTypeL(Rw)
End With 'WkBk.WkSht 'Iraos: In case you forgot, you don't have to scroll up and down to see which With is ending.
End Sub
I also changed the part the gets the data off the workshhet to a stand alone sub
Sub GetData(WkBk As Workbook, WkSht As Worksheet, Optional StartRow As Long = 2)
'Uses Modular level Variables
' DisplayTypeH
' DisplayTypeB
' DisplayTypeL
'And CN_ColumnNumbersAsnames Constants
Dim CorrectInput As Long
Dim Rw As Long
Const Col As Long = 1
Rw = StartRow
With WkBk.Sheets(WkSht)
Do While Cells(Rw, Col) <> "" 'Loop Thru every Row until Column A is empty
If (LCase(Cells(Rw, cnInputResponse)) = "male" And LCase(Cells(Rw, cnGender) = "m")) _
Or (LCase(Cells(Rw, cnInputResponse) = "female" And LCase(Cells(Rw, cnGender)) = "f")) _
Then CorrectInput = 1
Select Case UCase(Cells(Rw, cnDisplayType).Value)
Case "H"
With DisplayTypeH 'A UDT Type Variable. Each member is assigned a different value.
.TotalInputs = .TotalInputs + 1
.TotalCorrectInputs = .TotalCorrectInputs + CorrectInput
.TotalReactTime = .TotalReactTime + Cells(Rw, cnReactTime)
End With
Case "B"
With DisplayTypeB
.TotalInputs = .TotalInputs + 1
.TotalCorrectInputs = .TotalCorrectInputs + CorrectInput
.TotalReactTime = .TotalReactTime + Cells(Rw, cnReactTime)
End With
Case "L"
With DisplayTypeL
.TotalInputs = .TotalInputs + 1
.TotalCorrectInputs = .TotalCorrectInputs + CorrectInput
.TotalReactTime = .TotalReactTime + Cells(Rw, cnReactTime)
End With
End Select
Rw = Rw + 1
Loop
'Note that Rw is now equal to the Row just after the data
End With
End Sub
See the Code on Worksheet2 in the Attachment
Paul_Hossler
12-28-2013, 09:40 PM
I HATE
ActiveCell.Offset(1, 0).Select
ActiveCell.Value =
REPEATED A ZILLION TIMES
Don't ever do that again :whip :bat2:
OK, now tell us how you REALLY feel
BTW, that was a very patient as well as a very explanatory series of responses.
I hope the OP appreciates the effort
Paul
OK, now tell us how you REALLY feel
BTW, that was a very patient as well as a very explanatory series of responses.
I hope the OP appreciates the effort
Paul
FWIW, certainly a "ditto..." , "Bless you", and finally: LMAO!
Mark
I have written a function to let your users pick a folder to process for the data you need.
Function GetPathFolderToProcess(Optional StartFolderPath As String) As Variant
'Thanks to: http://www.vbaexpress.com/forum/showthread.php?48530-Need-help-creating-a-loop-macro-that-spits-out-a-master-data-file
Dim StartFolder As String
Dim FolderPicker As Office.FileDialog
Dim Result As Variant 'Multiuse Variable. Set = "" after completing each use!
''iraos: Checking for three requirements of a path:
'1: It is as long as a Drive Root folder Path
'2: It is at least a Drive Root folder Path
'3: It has the required slash at the end.
If Len(StartFolderPath) < 3 Then
StartFolder = ""
ElseIf Mid(StartFolderPath, 2, 2) <> ":\" Then
StartFolder = ""
ElseIf Right(StartFolderPath, 1) <> "\" Then
StartFolder = StartFolderPath & "\"
Else
StartFolder = StartFolderPath
End If
Set FolderPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FolderPicker 'Iraos: all Dot Variables belong to msoFileDialogFolderPicker
.AllowMultiSelect = False
.Title = "Please select The Folder To Process"
.InitialFileName = StartFolder
.Filters.Clear
.Filters.Add "Folders", "*.dir"
If .Show = -1 Then 'Iraos: The user pressed the OK button.
Result = .SelectedItems(1)
Else
Result = False
End If
End With
'Iraos: Makes for curteous code.
FolderPicker.Filters.Clear 'iraos: these hang around forwever until the next
'call for msoFileDialogFolderPicker.
'Iraos: Always Set any Object Variables to Nothing after you're done with them.
Set FolderPicker = Nothing
'Iraos: need to add "\" to make the Result a full Path
GetPathFolderToProcess = Result & "\"
'Iraos: The Result Variable dies at End Function
End Function
fredlo2010
12-29-2013, 07:13 PM
Amazing Job SamT.
I can't wait to get the feedback from the OP.
I definitively think this could qualify for one of those makeover tv shows. "Extreme Code Makeover" :)
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.