PDA

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!

SamT
12-28-2013, 09:46 AM
@ 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.

SamT
12-28-2013, 09:50 AM
I HATE
ActiveCell.Offset(1, 0).Select
ActiveCell.Value =

REPEATED A ZILLION TIMES

Don't ever do that again :whip :bat2:

SamT
12-28-2013, 09:54 AM
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

SamT
12-28-2013, 10:09 AM
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.)

SamT
12-28-2013, 10:10 AM
Eadier to read AND removes a (slower) Function call
If (inputResponse = "male" And gender = "m") _
Or (inputResponse = "female" And gender = "f") _
Then CorrectInput = 1

SamT
12-28-2013, 11:54 AM
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.

SamT
12-28-2013, 01:38 PM
@ 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

SamT
12-28-2013, 06:47 PM
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

GTO
12-29-2013, 05:04 AM
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

SamT
12-29-2013, 01:50 PM
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" :)