HELP!

[Christowl]

Hi,

I'm having trouble amending some code to work with the way our windows directory structure has changed.

While I can understand what VBA does I have no idea how to write it from fresh. If someone could please check the below there may be a pint in it for you (if you're in England).

The code is as follows;

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim a As Date
Dim b As Date
Dim c As String
Dim d As String
Dim e As Integer
Dim f As String
Dim g As Long
Dim h As Long
Dim i As Byte
Dim j() As String
Dim k As Integer
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Sheets("Ar AM").Activate
Range("a2:h" & Range("a2").End(xlDown).Row).Delete
Range("a2").Activate
Sheets("Other AM").Activate
Range("a2:i" & Range("a2").End(xlDown).Row).Delete
Range("a2").Activate
Sheets("Ar PM").Activate
Range("a2:h" & Range("a2").End(xlDown).Row).Delete
Range("a2").Activate
Sheets("Other PM").Activate
Range("a2:i" & Range("a2").End(xlDown).Row).Delete
Range("a2").Activate
a = InputBox("Please input the date FROM which you want to evaluate (dd-mm-yyyy)", "Date From")
b = InputBox("Please input the date TO which you want to evaluate (dd-mm-yyyy)", "Date To")
Sheets("Input Sheet").Activate
g = DateValue(a)
h = DateValue(b)
i = h - g
ReDim j(i) As String
For k = 0 To i
If Weekday(g) = 7 Or Weekday(g) = 1 Then
j(k) = "Ignore"
g = g + 1
Else
j(k) = Application.WorksheetFunction.Text(g, "dd-mm-yyyy")
g = g + 1
End If
Next k
'ok to here
Sheets("Other PM").Activate
Range("a2").Activate
Sheets("Ar PM").Activate
Range("a2").Activate
Sheets("Other AM").Activate
Range("a2").Activate
Sheets("Ar AM").Activate
Range("a2").Activate
On Error GoTo error_handler2
For k = 0 To i
If Not j(k) = "Ignore" Then
e = Right(j(k), 4)
c = UCase(Application.WorksheetFunction.Text(DateValue(j(k)), "MMM"))
Workbooks.Open ("P:\Planning and Supply\Kathryn\Article order display\" & e & "\" & c & "\" & Left(j(k), 6) & Right(j(k), 2) & " Order.xls")

But our directory is now structured like this;

P:\Planning and Supply\Kathryn\Article order display\2013\7 - Jul\03-07-13 order.xls

Any help would be much appreciated . . . . .

Chris

[Paul_Hossler]

Greetings and welcome to the forum

1. There's a square [V/B/A] button at the top that will insert markers that you can paste your code between to make it easier to read


Option Explicit
Sub What()
'more meaningful variable names would REALLY help
Dim a As Date
Dim b As Date
Dim c As String
Dim d As String
Dim e As Integer
Dim f As String
Dim g As Long
Dim h As Long
Dim i As Byte
Dim j() As String
Dim k As Integer

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'no need to .Select first
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Sheets("Ar AM").Range("a2:h" & Range("a2").End(xlDown).Row).Delete
Range("a2").Activate

Sheets("Other AM").Range("a2:i" & Range("a2").End(xlDown).Row).Delete
Range("a2").Activate

Sheets("Ar PM").Range("a2:h" & Range("a2").End(xlDown).Row).Delete
Range("a2").Activate

Sheets("Other PM").Range("a2:i" & Range("a2").End(xlDown).Row).Delete
Range("a2").Activate

'no error checking if no valid date returned
a = InputBox("Please input the date FROM which you want to evaluate (dd-mm-yyyy)", "Date From")
b = InputBox("Please input the date TO which you want to evaluate (dd-mm-yyyy)", "Date To")

Sheets("Input Sheet").Activate
g = DateValue(a)
h = DateValue(b)

i = h - g
ReDim j(i) As String

For k = 0 To i
'use built in constants to make it easier to read
If Weekday(g) = vbSunday Or Weekday(g) = vbMonday Then
j(k) = "Ignore"
g = g + 1
Else
j(k) = Application.WorksheetFunction.Text(g, "dd-mm-yyyy")
g = g + 1
End If
Next k

'ok to here
Sheets("Other PM").Activate
Range("a2").Activate
Sheets("Ar PM").Activate
Range("a2").Activate
Sheets("Other AM").Activate
Range("a2").Activate
Sheets("Ar AM").Activate
Range("a2").Activate

'assume it's somewhere in the unposted code
On Error GoTo error_handler2

For k = 0 To i
If Not j(k) = "Ignore" Then
e = Right(j(k), 4)
c = UCase(Application.WorksheetFunction.Text(DateValue(j(k)), "MMM"))
Workbooks.Open ("P:\Planning and Supply\Kathryn\Article order display\" & e & "\" & c & "\" & Left(j(k), 6) & Right(j(k), 2) & " Order.xls")
End Sub


2. I added a few unsolicited suggestions

3. It might be easier if you could provide just a very small code fragment with the crux of the question

4. Also a more specific title (instead of 'Help') usually solicites more responses

Paul

[SamT]

I think this is what you need. I also restyled the code to be more readable. I merely use Ctrl+H to replace some variable names wit what I preferred.

Other than a bit of cleanup, the last bit of code is what I changed/added.

Option Explicit

Sub SamT()

Dim DateFrom As String
Dim DateTo As String
Dim YearFolder As String
Dim DayMonFolder As String
Dim DayMonYrNamePrefix As String
Dim CurDate As Date
Dim LastDate As Date
Dim AllDates() As String
Dim i As Integer
Dim k As Integer

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'Which sheet does this next line operate on?
Columns("A:A").TextToColumns Destination:=Range("A1"), _
Tab:=True, TrailingMinusNumbers:=True

Sheets("Ar AM").Range("a2:LastDate" & Range("a2").End(xlDown).Row).Delete
Sheets("Other AM").Range("a2:i" & Range("a2").End(xlDown).Row).Delete
Sheets("Ar PM").Range("a2:LastDate" & Range("a2").End(xlDown).Row).Delete
Sheets("Other PM").Range("a2:i" & Range("a2").End(xlDown).Row).Delete


DateFrom = InputBox("Please input the date FROM which you want to evaluate (dd-mm-yyyy)", "Date From")
DateTo = InputBox("Please input the date TO which you want to evaluate (dd-mm-yyyy)", "Date To")
CurDate = DateValue(DateFrom)
LastDate = DateValue(DateTo)

Sheets("Input Sheet").Activate 'Why?

i = LastDate - CurDate
ReDim AllDates(i) As String
For k = 0 To i
If Weekday(CurDate) = vbSaturday Or Weekday(CurDate) = vbSunday Then
AllDates(k) = "Ignore"
Else
AllDates(k) = CurDate
End If
CurDate = CurDate + 1
Next k

On Error GoTo error_handler2 'Where is?

For k = 0 To i
If Not AllDates(k) = "Ignore" Then
YearFolder = Format(AllDates(k), "yyyy") & "\"
DayMonFolder = Format(AllDates(k), "d-mmm") & "\"
DayMonYrNamePrefix = Format(AllDates(k), "dd-mm-yy")
Workbooks.Open _
("P:\Planning and Supply\Kathryn\Article order display\" _
& YearFolder & DayMonFolder & DayMonYrNamePrefix & " Order.xls")

End Sub

[Christowl]

Hi,

Thank you and apologies about the poor etiquette, I'll correct this in the future.

Thank you both.

Sam, I've tried that code and it throws up a ' sub or function not defined error later on. I've tried to correct this to what I think it should be but it doesn't work.

The original is;
Windows(Left(j(k), 6) & Right(j(k), 2) & " Order.xls").Activate
Sheets("Other AM").Activate

Which I tried to correct to;
Windows((YearFolder) & (DayMonFolder) & (DayMonYrNamePrefix)) & " Order.xls").Activate
Sheets("Other AM").Activate

Which brings back 'Expected: End of statement'.

Apologies . . . . .

Chris

[Paul_Hossler]

This is just a fragment of one way to build the file path. Two different dates just to test, and I just forced in the dates instead of reading them from as worksheet or getting them from the user



Option Explicit
Sub CodeFragment()
Dim dtFrom As Date, dtTo As Date
Dim sYear As String, sFolder As String, sFile As String, sPath As String

'put date into variable for demo
dtFrom = #7/3/2013#
sYear = Format(dtFrom, "yyyy")
sFolder = Format(dtFrom, "m - mmm")
sFile = Format(dtFrom, "dd-mm-yy")
sPath = "P:\Planning and Supply\Kathryn\Article order display\"
sPath = sPath & sYear & "\"
sPath = sPath & sFolder & "\"
sPath = sPath & sFile & " order.xls"

MsgBox sPath
'put date into variable for demo
dtFrom = #12/25/2013#
sYear = Format(dtFrom, "yyyy")
sFolder = Format(dtFrom, "m - mmm")
sFile = Format(dtFrom, "dd-mm-yy")
sPath = "P:\Planning and Supply\Kathryn\Article order display\"
sPath = sPath & sYear & "\"
sPath = sPath & sFolder & "\"
sPath = sPath & sFile & " order.xls"

MsgBox sPath

End Sub


This is just to demo a technique that you might use in the part of your sub where you do the FileOpen

If you single step through the sub and hover the mouse over the variable as you do, you can see where and how the pieces are generated

Paul

[SamT]

Hi,

Thank you and apologies about the poor etiquette, I'll correct this in the future.

Thank you both.

Sam, I've tried that code and it throws up a ' sub or function not defined error later on. I've tried to correct this to what I think it should be but it doesn't work.

The original is;
Windows(Left(j(k), 6) & Right(j(k), 2) & " Order.xls").Activate
Sheets("Other AM").Activate
Which I tried to correct to;
Windows((YearFolder) & (DayMonFolder) & (DayMonYrNamePrefix)) & " Order.xls").Activate
Sheets("Other AM").Activate
Which brings back 'Expected: End of statement'.

Apologies . . . . .

Chris
Take everything in your original sub From (Including) Application.DisplayAlerts = False to (Including Workbooks.Open ("P:\Planning and Supply\Kathryn\Article order display\" & e & "\" & c & "\" & Left(j(k), 6) & Right(j(k), 2) & " Order.xls")

And replace it with the contents of my example. I don't know what you have in your code, except what you posted.

After that, put these constants and new variables in your code and replace the AllDates Loop with the one in this sub.

Sub Samt()
'Get workbook name from AllDates
Const MainPath As String = "P:\Planning and Supply\Kathryn\Article order display\"

Dim SubPath As String 'Value depends on date
Dim BkName As String 'Value depends on date

For k = 0 To i
If Not AllDates(k) = "Ignore" Then
YearFolder = Format(AllDates(k), "yyyy") & "\"
DayMonFolder = Format(AllDates(k), "d-mmm") & "\"

SubPath = YearFolder & DayMonFolder
BkName = DayMonYrNamePrefix & " Order.xls"

Workbooks.Open (MainPath & SubPath & BkName)
End If
Workbooks(BkName).Sheets("Other AM").Activate
Next k

End Sub
To get help on any VBA word, put the cursor in the word and press F1

Notice that I used "Format" to get the date parts from Array(AllDates?) That is because AllDates contains Dates as a kind of number variable and Format is designed to work with numbers.

In windows dates are stored as a Date Type number and the Date Type is identical to the Double Type number.

Also pay attention to how I did not use any "Sheets(?).Activate,.. Range(... " in my code

Purists, I know, but I believe in starting beginners in the shallow end :friends:

[Christowl]

Thank you so much for both of your help. I've been trying to get it working for the last few days by myself but it's getting beyond frustrating now.

I've had to make changes to the original and 2nd version due to error and now I don't know where I am.

Probably should have done this at the start but here's all the code:

Option Explicit
Option Base 0
Sub b()
Const MainPath As String = "P:\Planning and Supply\Kathryn\Article order display\"
Dim DateFrom As String
Dim DateTo As String
Dim YearFolder As String
Dim DayMonFolder As String
Dim DayMonYrNamePrefix As String
Dim CurDate As Date
Dim LastDate As Date
Dim AllDates() As String
Dim i As Integer
Dim k As Integer
Dim BkName As String
Dim SubPath As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'Which sheet does this next line operate on?
Columns("A:A").TextToColumns Destination:=Range("A1"), _
Tab:=True, TrailingMinusNumbers:=True

Sheets("Ar AM").Range("a2:i" & Range("a2").End(xlDown).Row).Delete
Sheets("Other AM").Range("a2:i" & Range("a2").End(xlDown).Row).Delete
Sheets("Ar PM").Range("a2:i" & Range("a2").End(xlDown).Row).Delete
Sheets("Other PM").Range("a2:i" & Range("a2").End(xlDown).Row).Delete


DateFrom = InputBox("Please input the date FROM which you want to evaluate (dd-mm-yyyy)", "Date From")
DateTo = InputBox("Please input the date TO which you want to evaluate (dd-mm-yyyy)", "Date To")
CurDate = DateValue(DateFrom)
LastDate = DateValue(DateTo)

Sheets("Input Sheet").Activate 'Why?

i = LastDate - CurDate
ReDim AllDates(i) As String
For k = 0 To i
If Weekday(CurDate) = vbSaturday Or Weekday(CurDate) = vbSunday Then
AllDates(k) = "Ignore"
Else
AllDates(k) = CurDate
End If
CurDate = CurDate + 1
Next k

On Error GoTo error_handler2 'Where is?

For k = 0 To i
If Not AllDates(k) = "Ignore" Then
YearFolder = Format(AllDates(k), "yyyy") & "\"
DayMonFolder = Format(AllDates(k), "d-mmm") & "\"
SubPath = YearFolder & DayMonFolder
BkName = DayMonYrNamePrefix & " Order.xls"

Workbooks.Open (MainPath & SubPath & BkName)
Workbooks(BkName).Sheets("Other AM").Activate

Sheets("Ar AM").Select
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("E:E").Select
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Sheets("Other AM").Select
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("E:E").Select
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Sheets("Ar PM").Select
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("E:E").Select
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Sheets("Other PM").Select
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("E:E").Select
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
'to here 17/10/2011
Sheets("Pivots").Activate
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable3").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable4").PivotCache.Refresh
Sheets("Input Sheet").Activate
Range("a2").Activate
Application.DisplayAlerts = False
Application.ScreenUpdating = False
MsgBox ("The macro has completed")
End If


Sorry to be such a pain :(

[SamT]

For your reading pleasure.

The following code segment is operationally identical to your code post above with errors, (if any,) and all. I have only removed redundant Selections and Activations and unneccessary default parameters.
Workbooks.Open (MainPath & SubPath & BkName)

With Workbooks(BkName)
With Sheets("Ar AM")
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
FieldInfo :=Array(1, 1), TrailingMinusNumbers:=True

Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
FieldInfo :=Array(1, 1), TrailingMinusNumbers:=True

Columns("E:E").TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
FieldInfo :=Array(1, 1), TrailingMinusNumbers:=True
End With

With Sheets("Other AM")
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
FieldInfo :=Array(1, 1), TrailingMinusNumbers:=True

Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
FieldInfo :=Array(1, 1), TrailingMinusNumbers:=True

Columns("E:E").TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
FieldInfo :=Array(1, 1), TrailingMinusNumbers:=True
End With

With Sheets("Ar PM")
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
FieldInfo :=Array(1, 1), TrailingMinusNumbers:=True

Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
FieldInfo :=Array(1, 1), TrailingMinusNumbers:=True

Columns("E:E").TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
FieldInfo :=Array(1, 1), TrailingMinusNumbers:=True

End With

With Sheets("Other PM")
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
FieldInfo :=Array(1, 1), TrailingMinusNumbers:=True

Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
FieldInfo :=Array(1, 1), TrailingMinusNumbers:=True

Columns("E:E").TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
FieldInfo :=Array(1, 1), TrailingMinusNumbers:=True
End With

With Sheets("Pivots").
.PivotTables("PivotTable1").PivotCache.Refresh
.PivotTables("PivotTable2").PivotCache.Refresh
.PivotTables("PivotTable3").PivotCache.Refresh
.PivotTables("PivotTable4").PivotCache.Refresh
End With

Sheets("Input Sheet").Range("a2").Activate 'Why
End With 'BkName

Application.DisplayAlerts = False
Application.ScreenUpdating = False

MsgBox ("The macro has completed")


As soon as I had cleaned up and formatted your code, I recognized that the entire TextToColumns Segment can be reduced to
With Workbooks(BkName)
Dim ShtArray As Variant
ShtArray = Array("Ar AM", "Ar PM", "Other PM")
For i = 0 to 2
With Sheets(ShtArray(i))
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
FieldInfo :=Array(1, 1), TrailingMinusNumbers:=True

Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
FieldInfo :=Array(1, 1), TrailingMinusNumbers:=True

Columns("E:E").TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
FieldInfo :=Array(1, 1), TrailingMinusNumbers:=True
End With
Next i
End With

I did it for you because I use UltraEdit and it literally took me longer to format the code than to edit it.

[Christowl]

Many thanks Sam, I'll give this a go on Monday.

Does that mean the first section of code was correct?

Cheers.

Chris

[SamT]

No, I still just reformatted the same old code. That little bit of refactoring on the loop didn't change anything operationally.

I wish I was like some of these guys who can read the code once and understand it. I have to play with it, refactor it for readability where possible and generally familiarize myself with it first.

You can take the second short segment I gave and replace everything in that long list of TextToColumns of yours with it.You will have to replace the i variable with a different one, maybe j. I wasn't working in the VBA editor, so I just picked i out of the blue.

I will now try to see if I can find the problem. Probably rewrite some of it too. :)

[SamT]

Christowl,

I'm looking at the (in)complete code you posted in posted #7 and you need to answer three questions

1)What code page has the code? Some worksheet, ThisWorkbook, or a module? How is the macro called? From the Macros menu, a button click? Which sheet is active when the macro is called?

2) 'Which sheet does this next line operate on?
Columns("A:A").TextToColumns Destination:=Range("A1"), _
Tab:=True, TrailingMinusNumbers:=True

3) And, Where's the rest of the code? the part afterMsgBox ("The macro has completed")

Ok 5 Q's. I never did learn to count good.

[SamT]

About TextToColumns: T2C, as you are using it, assumes that the source (A1 herein) contains many values, (single words or phrases,) each enclosed in double quotes, and separated by Tabs.

For Example if A1 contains: "This is a show"(TabB)"of"(TabC)"TextToColumns"(TabD)"output"(TabE)(TabF)"with"(TabG)"ConsecutiveDelimiter set True"
Columns Values
A1 This is a show
B1 of
C1 TextToColumns
D1 output
E1 with
F1 ConsecutiveDelimiter set True
G1

Anytime you use T2C on two consecutive columns, the output of the first column will overwrite the data in the second column.

This simply means that the code algorithm does not match the data because you are using T2C on adjacent columns without problems.

The Workbook open code assumes that there are no missing date books in the folder other than Sat and Sun.

I think you need to set the code aside for a while and upload some sample documents for us and tell us what you want to accomplish with them. We will probably use some of the existing code because quite a bit of it seems to work just fine.

Be sure to obfuscate any personal or proprietary data in the uploads.

To upload, use "Go Advanced" and "Manage Attachments" below the advanced editor.