Help with looping?? VB...

[Davers]

I have a workbook that imports .txt files for 27 departments and pastes each departments data on it's corresponding worksheet. Just one sheet is the import page. It imports one document, then pastes the pertinent data onto the correct departments worksheet...etc for all 27 departments..That's a lot of repeating code when you don't know how to loop things....is there a way to have one block of code repeat the operation for each department?? Actually, I'm pretty sure there is a way, I just don't know how to do it!! Can anyone help with this...here is the code as I have it now:

Sub cmdUpdateMCCData()

Module3.importMCC
'Define Variables that are used in the program
Dim Dt3 As String 'Dt3 stores the working date
Dim Nm3 As String 'Nm3 stores the split name
Dim CopyFromSheet, WorkingDate, WorkingName, myData, PasteToSheet, PasteToRange As String
Dim c As Variant 'c refers to working cell in defined range


CopyFromSheet = Range("CopyFromSheet")
WorkingDate = Range("WorkingDate")
WorkingName = Range("WorkingName")
myData = Range("myData")
PasteToSheet = Range("PasteToSheet")
PasteToRange = Range("PasteToRange")

Dt3 = Worksheets(CopyFromSheet).Range(WorkingDate)
Nm3 = Worksheets(CopyFromSheet).Range(WorkingName)

With Worksheets(CopyFromSheet)
.Activate
.Range(myData).Copy
End With

With Worksheets(PasteToSheet)
.Activate
.Range(PasteToRange).Select
End With

For Each c In Range(PasteToRange) 'Range evaluated to determine where to paste data for Dt3
If c.Value = Dt3 Then GoTo myPaste
Next c

MsgBox "Date not found!", vbExclamation
Exit Sub


myPaste: 'Paste values into appropriate column
c.Activate
ActiveCell.Offset(1, 0).Select
ActiveSheet.PasteSpecial Format:=3

cmdUpdateOCMData

End Sub

Sub importMCC()

Sheets("RawData").Select
Range("A1:AD100").Select
Selection.ClearContents
Selection.QueryTable.Delete
Range("A1").Select

Sheets("RawData").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;W:\rcbwpa\Scripts\DailyPerformance\40.txt", _
Destination:=Range("A2"))
.Name = "40"
.FieldNames = True
.PreserveFormatting = True
.RefreshStyle = xlOverwriteCells
.AdjustColumnWidth = False
.TextFileTabDelimiter = True
.PreserveFormatting = False
.AdjustColumnWidth = False
.TextFileColumnDataTypes = Array(1, 1)
.Refresh BackgroundQuery:=False
End With

End Sub

As you can see, the code sort of bounces back and forth between module 1 and module 3...(there is no module 2). After it runs this whole block of code, you can see I just tell it to run the next block of code for the next department..ie cmdUpdateOCMData and so on and so forth...because of this...my workbook is over 6 megs!! Ouch!! Any ideas on how to clean this up??

Thanks,

Dave M.

 

[Damon Ostrander]

Hi Davers,

This should be quite easy to set up a loop for. But one detail is essential: how are the department files named? Is the first one "01.txt" or "1.txt"?

Damon

PS. I also want to caution you that the code:

Dim CopyFromSheet, WorkingDate, WorkingName, myData, PasteToSheet, PasteToRange As String

does not declare all these variables as String. It declares PasteToRange as String, and all the others as Variant.