M
MrGreenFingas
I Am currently trying to collate some data from a number of different
excel files and combine them into one
I currently have the following code written:-
Public wb As Workbook
Public TheFile As String
Public MyPath As String
Public rowNumber As Integer
Public M6Testdrives As Integer
Public M5Testdrives As Integer
Public M3Testdrives As Integer
Public M2Testdrives As Integer
Public RXTestdrives As Integer
Public MXTestdrives As Integer
Public BSTestdrives As Integer
Public M6Brochure As Integer
Public M5Brochure As Integer
Public M3Brochure As Integer
Public M2Brochure As Integer
Public RXBrochure As Integer
Public MXBrochure As Integer
Public BSBrochure As Integer
Sub TestMac()
MyPath = "C:\ExcelTest"
ChDir MyPath
TheFile = Dir("*.xls")
rowNumber = 2
Do While TheFile <> ""
Set wb = Workbooks.Open(MyPath & "\" & TheFile)
'MsgBox "Row Number out of loop Loop = " & rowNumber
With wb.ActiveSheet
.Unprotect pw
'With workbooks(TheFile)
Do Until Cells(rowNumber, 24) = ""
'MsgBox "In Loop Current Cell Value = " & Cells(rowNumber, 24)
If Cells(rowNumber, 24) = "Y" Then
If Cells(rowNumber, 16) = "Mazda6" Then
M6Testdrives = M6Testdrives + 1
End If
If Cells(rowNumber, 16) = "Mazda5" Then
M5Testdrives = M5Testdrives + 1
End If
If Cells(rowNumber, 16) = "Mazda3" Then
M3Testdrives = M3Testdrives + 1
End If
If Cells(rowNumber, 16) = "Mazda2" Then
M2Testdrives = M2Testdrives + 1
End If
If Cells(rowNumber, 16) = "RX-8" Then
RXTestdrives = RXTestdrives + 1
End If
If Cells(rowNumber, 16) = "MX-5" Then
MXTestdrives = MXTestdrives + 1
End If
If Cells(rowNumber, 16) = "BSeries" Then
BSTestdrives = BSTestdrives + 1
End If
End If
If Cells(rowNumber, 25) = True Then
If Cells(rowNumber, 16) = "Mazda6" Then
M6Brochure = M6Brochure + 1
End If
If Cells(rowNumber, 16) = "Mazda5" Then
M5Brochure = M5Brochure + 1
End If
If Cells(rowNumber, 16) = "Mazda3" Then
M3Brochure = M3Brochure + 1
End If
If Cells(rowNumber, 16) = "Mazda2" Then
M2Brochure = M2Brochure + 1
End If
If Cells(rowNumber, 16) = "RX-8" Then
RXBrochure = RXBrochure + 1
End If
If Cells(rowNumber, 16) = "MX-5" Then
MXBrochure = MXBrochure + 1
End If
If Cells(rowNumber, 16) = "BSeries" Then
BSBrochure = BSBrochure + 1
End If
End If
rowNumber = rowNumber + 1
.Protect pw, True, True, True
Loop
End With
'End With
wb.Close
TheFile = Dir
Loop
Cells(16, 2) = Cells(16, 2) + M6Testdrives
Cells(16, 3) = Cells(16, 3) + M6Brochure
Cells(17, 2) = Cells(17, 2) + M5Testdrives
Cells(17, 3) = Cells(17, 3) + M5Brochure
Cells(18, 2) = Cells(18, 2) + M3Testdrives
Cells(18, 3) = Cells(18, 3) + M3Brochure
Cells(19, 2) = Cells(19, 2) + M2Testdrives
Cells(19, 3) = Cells(19, 3) + M2Brochure
Cells(20, 2) = Cells(20, 2) + RXTestdrives
Cells(20, 3) = Cells(20, 3) + RXBrochure
Cells(21, 2) = Cells(21, 2) + MXTestdrives
Cells(21, 3) = Cells(21, 3) + MXBrochure
Cells(22, 2) = Cells(22, 2) + BSTestdrives
Cells(22, 3) = Cells(22, 3) + BSBrochure
Cells(23, 2) = Cells(22, 3) + rowNumber - 2
End Sub
Now the problem is everytime i open a work book i want the Do Until
loop to run on the workbook i just opened i.e. TheFile, but the cells
section you see just above to write into the workbook containing the
macro.
Please can someone help me this is so frustrating i just cannot get
that section of code to execute on the correct work book. Please not
this is not the code i began with its just i have changed that many
times to get it to run on the correct book but to no avail.
Many Thanks Guys
excel files and combine them into one
I currently have the following code written:-
Public wb As Workbook
Public TheFile As String
Public MyPath As String
Public rowNumber As Integer
Public M6Testdrives As Integer
Public M5Testdrives As Integer
Public M3Testdrives As Integer
Public M2Testdrives As Integer
Public RXTestdrives As Integer
Public MXTestdrives As Integer
Public BSTestdrives As Integer
Public M6Brochure As Integer
Public M5Brochure As Integer
Public M3Brochure As Integer
Public M2Brochure As Integer
Public RXBrochure As Integer
Public MXBrochure As Integer
Public BSBrochure As Integer
Sub TestMac()
MyPath = "C:\ExcelTest"
ChDir MyPath
TheFile = Dir("*.xls")
rowNumber = 2
Do While TheFile <> ""
Set wb = Workbooks.Open(MyPath & "\" & TheFile)
'MsgBox "Row Number out of loop Loop = " & rowNumber
With wb.ActiveSheet
.Unprotect pw
'With workbooks(TheFile)
Do Until Cells(rowNumber, 24) = ""
'MsgBox "In Loop Current Cell Value = " & Cells(rowNumber, 24)
If Cells(rowNumber, 24) = "Y" Then
If Cells(rowNumber, 16) = "Mazda6" Then
M6Testdrives = M6Testdrives + 1
End If
If Cells(rowNumber, 16) = "Mazda5" Then
M5Testdrives = M5Testdrives + 1
End If
If Cells(rowNumber, 16) = "Mazda3" Then
M3Testdrives = M3Testdrives + 1
End If
If Cells(rowNumber, 16) = "Mazda2" Then
M2Testdrives = M2Testdrives + 1
End If
If Cells(rowNumber, 16) = "RX-8" Then
RXTestdrives = RXTestdrives + 1
End If
If Cells(rowNumber, 16) = "MX-5" Then
MXTestdrives = MXTestdrives + 1
End If
If Cells(rowNumber, 16) = "BSeries" Then
BSTestdrives = BSTestdrives + 1
End If
End If
If Cells(rowNumber, 25) = True Then
If Cells(rowNumber, 16) = "Mazda6" Then
M6Brochure = M6Brochure + 1
End If
If Cells(rowNumber, 16) = "Mazda5" Then
M5Brochure = M5Brochure + 1
End If
If Cells(rowNumber, 16) = "Mazda3" Then
M3Brochure = M3Brochure + 1
End If
If Cells(rowNumber, 16) = "Mazda2" Then
M2Brochure = M2Brochure + 1
End If
If Cells(rowNumber, 16) = "RX-8" Then
RXBrochure = RXBrochure + 1
End If
If Cells(rowNumber, 16) = "MX-5" Then
MXBrochure = MXBrochure + 1
End If
If Cells(rowNumber, 16) = "BSeries" Then
BSBrochure = BSBrochure + 1
End If
End If
rowNumber = rowNumber + 1
.Protect pw, True, True, True
Loop
End With
'End With
wb.Close
TheFile = Dir
Loop
Cells(16, 2) = Cells(16, 2) + M6Testdrives
Cells(16, 3) = Cells(16, 3) + M6Brochure
Cells(17, 2) = Cells(17, 2) + M5Testdrives
Cells(17, 3) = Cells(17, 3) + M5Brochure
Cells(18, 2) = Cells(18, 2) + M3Testdrives
Cells(18, 3) = Cells(18, 3) + M3Brochure
Cells(19, 2) = Cells(19, 2) + M2Testdrives
Cells(19, 3) = Cells(19, 3) + M2Brochure
Cells(20, 2) = Cells(20, 2) + RXTestdrives
Cells(20, 3) = Cells(20, 3) + RXBrochure
Cells(21, 2) = Cells(21, 2) + MXTestdrives
Cells(21, 3) = Cells(21, 3) + MXBrochure
Cells(22, 2) = Cells(22, 2) + BSTestdrives
Cells(22, 3) = Cells(22, 3) + BSBrochure
Cells(23, 2) = Cells(22, 3) + rowNumber - 2
End Sub
Now the problem is everytime i open a work book i want the Do Until
loop to run on the workbook i just opened i.e. TheFile, but the cells
section you see just above to write into the workbook containing the
macro.
Please can someone help me this is so frustrating i just cannot get
that section of code to execute on the correct work book. Please not
this is not the code i began with its just i have changed that many
times to get it to run on the correct book but to no avail.
Many Thanks Guys