Text To Columns Causing File Save?

R

reberryjr

Well-known Member
Joined
Mar 16, 2017
Messages
714
Office Version
  1. 365
Platform
  1. Windows
I'm running the code below, and for some reason when the Text to Columns line is hit, it appears to be saving the file, which is throwing an error further down in the code. I have looked and looked, and don't see anywhere that I'm saving the file, so is it something that happens "behind the scenes"?

Code: 
Sub CopyEmails_AM()
Application.ScreenUpdating = False
Dim m, s As Workbook
Dim mws, sws1, sws2, sws3, sws4, sws5, sws6, sws7 As Worksheet
Dim i, mLR As Long
Set m = ThisWorkbook
Set mws = ThisWorkbook.Sheets("AM_Consolidated")
mLR = mws.Range("A" & Rows.Count).End(xlUp).Row
mQLR = mws.Range("D" & Rows.Count).End(xlUp).Row
Set s = Workbooks.Open("C:\FilePath.xlsx")
Set sws1 = s.Worksheets("FL_LOP")
Set sws2 = s.Worksheets("C_Claims")
Set sws3 = s.Worksheets("TILA")
Set sws4 = s.Worksheets("US_Card_Lit")
Set sws5 = s.Worksheets("CAT")
Set sws6 = s.Worksheets("CRT")
Set sws7 = s.Worksheets("ELT")
sws1LR = sws1.Range("A" & Rows.Count).End(xlUp).Row
sws2LR = sws2.Range("A" & Rows.Count).End(xlUp).Row
sws3LR = sws3.Range("D" & Rows.Count).End(xlUp).Row
sws4LR = sws4.Range("D" & Rows.Count).End(xlUp).Row
sws5LR = sws5.Range("D" & Rows.Count).End(xlUp).Row
sws6LR = sws6.Range("D" & Rows.Count).End(xlUp).Row
sws7LR = sws7.Range("D" & Rows.Count).End(xlUp).Row
sws1.Activate
If sws1.Range("A2").Value = "" Then GoTo C_Claims
    With sws1.Range("F2:F" & sws1LR)
        .TextToColumns Destination:=sws1.Range("F2"), _
        DataType:=xlDelimited, _
        Space:=True, _
        FieldInfo:=Array(Array(1, 9), Array(2, 3), Array(3, 9), Array(4, 9))
    End With
    
    sws1.Range(Cells(2, 1), Cells(sws1LR, 1)).Copy
        mws.Range("B" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    sws1.Range(Cells(2, 2), Cells(sws1LR, 2)).Copy
        mws.Range("C" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    sws1.Range(Cells(2, 6), Cells(sws1LR, 6)).Copy
        mws.Range("D" & mLR + 1).PasteSpecial Paste:=xlPasteValues
        
With mws.Range("F" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 4))
    .Value = "FL_LOP"
End With
With mws.Range("A" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, -1))
    .Value = "FL_LOP"
End With
With mws.Range("H" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 6))
    .Value = Format(Now, "MM/DD/YY")
End With
With mws.Range("I" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 7))
    .Value = "Y"
End With
With mws.Range("E" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 3))
    .Value = "=WORKDAY(TODAY(),1,Variables!R2C[-1]:R11C[-1])"
End With
GoTo C_Claims
C_Claims:
mLR = mws.Range("A" & Rows.Count).End(xlUp).Row
mQLR = mws.Range("D" & Rows.Count).End(xlUp).Row
sws2.Activate
sws2.Range("E1").Value = "Empty"
If sws2.Range("A2").Value = "" Then GoTo TILA
    With sws2.Range("F2:F" & sws2LR)
        .TextToColumns Destination:=sws2.Range("F2"), _
        DataType:=xlDelimited, _
        Space:=True, _
        FieldInfo:=Array(Array(1, 9), Array(2, 3), Array(3, 9), Array(4, 9))
    End With
    
    sws2.Range(Cells(2, 1), Cells(sws1LR, 1)).Copy
        mws.Range("B" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    sws2.Range(Cells(2, 2), Cells(sws1LR, 2)).Copy
        mws.Range("C" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    sws2.Range(Cells(2, 6), Cells(sws1LR, 6)).Copy
        mws.Range("D" & mLR + 1).PasteSpecial Paste:=xlPasteValues
        
With mws.Range("F" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 4))
    .Value = "C Claims"
End With
With mws.Range("A" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, -1))
    .Value = "C Claims"
End With
With mws.Range("H" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 6))
    .Value = Format(Now, "MM/DD/YY")
End With
With mws.Range("I" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 7))
    .Value = "Y"
End With
With mws.Range("E" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 3))
    .Value = "=WORKDAY(TODAY(),1,Variables!R2C[-1]:R11C[-1])"
End With
GoTo TILA:
TILA:
mLR = mws.Range("A" & Rows.Count).End(xlUp).Row
mQLR = mws.Range("D" & Rows.Count).End(xlUp).Row
sws3.Activate
sws3.Range("E1").Value = "Empty"
If sws3.Range("D2").Value = "" Then GoTo US_Card_Lit
    'Who to Bucket 1
    sws3.Range(Cells(2, 4), Cells(sws3LR, 4)).Copy
        mws.Range("B" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    'Subject to Bucket 2
    sws3.Range(Cells(2, 9), Cells(sws3LR, 9)).Copy
        mws.Range("C" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    'Assigned On to Date
    sws3.Range(Cells(2, 6), Cells(sws3LR, 6)).Copy
        mws.Range("D" & mLR + 1).PasteSpecial Paste:=xlPasteValues
        
    'Calculates SLA - Adds 2 workdays to received date.
    With mws.Range("E" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 3))
    .Value = "=WORKDAY(TODAY(),2,Variables!R2C[-1]:R11C[-1])"
    End With
    
    With mws.Range("F" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 4))
        .Value = "TIlA"
    End With
    With mws.Range("A" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, -1))
        .Value = "TILA"
    End With
    
    With mws.Range("H" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 6))
        .Value = Format(Now, "MM/DD/YY")
    End With
    
    With mws.Range("I" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 7))
        .Value = "Y"
    End With
GoTo US_Card_Lit
US_Card_Lit:
mLR = mws.Range("A" & Rows.Count).End(xlUp).Row
mQLR = mws.Range("D" & Rows.Count).End(xlUp).Row
sws4.Activate
sws4.Range("E1").Value = "Empty"
If sws4.Range("D2").Value = "" Then GoTo CRT
    'Who to Bucket 1
    sws4.Range(Cells(2, 4), Cells(sws4LR, 4)).Copy
        mws.Range("B" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    'Subject to Bucket 2
    sws4.Range(Cells(2, 9), Cells(sws4LR, 9)).Copy
        mws.Range("C" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    'Assigned On to Date
    sws4.Range(Cells(2, 6), Cells(sws4LR, 6)).Copy
        mws.Range("D" & mLR + 1).PasteSpecial Paste:=xlPasteValues
        
    'Calculates SLA - Adds 2 workdays to received date.
    With mws.Range("E" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 3))
    .Value = "=WORKDAY(TODAY(),2,Variables!R2C[-1]:R11C[-1])"
    End With
    
    With mws.Range("F" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 4))
        .Value = "US_Card_Lit"
    End With
    With mws.Range("A" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, -1))
        .Value = "US_Card_Lit"
    End With
    
    With mws.Range("H" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 6))
        .Value = Format(Now, "MM/DD/YY")
    End With
    
    With mws.Range("I" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 7))
        .Value = "Y"
    End With
GoTo CAT
CAT:
mLR = mws.Range("A" & Rows.Count).End(xlUp).Row
mQLR = mws.Range("D" & Rows.Count).End(xlUp).Row
sws5.Activate
sws5.Range("E1").Value = "Empty"
If sws5.Range("D2").Value = "" Then GoTo CRT
    'Who to Bucket 1
    sws5.Range(Cells(2, 4), Cells(sws5LR, 4)).Copy
        mws.Range("B" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    'Subject to Bucket 2
    sws5.Range(Cells(2, 9), Cells(sws5LR, 9)).Copy
        mws.Range("C" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    'Assigned On to Date
    sws5.Range(Cells(2, 6), Cells(sws5LR, 6)).Copy
        mws.Range("D" & mLR + 1).PasteSpecial Paste:=xlPasteValues
        
    'Calculates SLA - Adds 2 workdays to received date.
    With mws.Range("E" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 3))
    .Value = "=WORKDAY(TODAY(),2,Variables!R2C[-1]:R11C[-1])"
    End With
    
    With mws.Range("F" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 4))
        .Value = "CAT"
    End With
    With mws.Range("A" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, -1))
        .Value = "CAT"
    End With
    
    With mws.Range("H" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 6))
        .Value = Format(Now, "MM/DD/YY")
    End With
    
    With mws.Range("I" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 7))
        .Value = "Y"
    End With
    
GoTo CRT
CRT:
mLR = mws.Range("A" & Rows.Count).End(xlUp).Row
mQLR = mws.Range("D" & Rows.Count).End(xlUp).Row
sws6.Activate
sws6.Range("E1").Value = "Empty"
If sws6.Range("D2").Value = "" Then GoTo ELT
    'Who to Bucket 1
    sws6.Range(Cells(2, 4), Cells(sws6LR, 4)).Copy
        mws.Range("B" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    'Subject to Bucket 2
    sws6.Range(Cells(2, 9), Cells(sws6LR, 9)).Copy
        mws.Range("C" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    'Assigned On to Date
    sws6.Range(Cells(2, 6), Cells(sws6LR, 6)).Copy
        mws.Range("D" & mLR + 1).PasteSpecial Paste:=xlPasteValues
        
    'Calculates SLA - Adds 2 workdays to received date.
    With mws.Range("E" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 3))
    .Value = "=WORKDAY(TODAY(),2,Variables!R2C[-1]:R11C[-1])"
    End With
    
    With mws.Range("F" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 4))
        .Value = "CRT"
    End With
    With mws.Range("A" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, -1))
        .Value = "CRT"
    End With
    
    With mws.Range("H" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 6))
        .Value = Format(Now, "MM/DD/YY")
    End With
    
    With mws.Range("I" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 7))
        .Value = "Y"
    End With
    
GoTo ELT
ELT:
If sws7.Range("D2").Value = "" Then
    s.Close SaveChanges = False
    Exit Sub
End If
mLR = mws.Range("A" & Rows.Count).End(xlUp).Row
mQLR = mws.Range("D" & Rows.Count).End(xlUp).Row
sws7.Activate
sws7.Range("E1").Value = "Empty"
    'Who to Bucket 1
    sws7.Range(Cells(2, 4), Cells(sws6LR, 4)).Copy
        mws.Range("B" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    'Subject to Bucket 2
    sws7.Range(Cells(2, 9), Cells(sws6LR, 9)).Copy
        mws.Range("C" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    'Assigned On to Date
    sws7.Range(Cells(2, 6), Cells(sws6LR, 6)).Copy
        mws.Range("D" & mLR + 1).PasteSpecial Paste:=xlPasteValues
        
    'Calculates SLA - Adds 2 workdays to received date.
    With mws.Range("E" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 3))
    .Value = "=WORKDAY(TODAY(),2,Variables!R2C[-1]:R11C[-1])"
    End With
    
    With mws.Range("F" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 4))
        .Value = "ELT"
    End With
    With mws.Range("A" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, -1))
        .Value = "ELT"
    End With
    
    With mws.Range("H" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 6))
        .Value = Format(Now, "MM/DD/YY")
    End With
    
    With mws.Range("I" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 7))
        .Value = "Y"
    End With
s.Close SaveChanges = False
Application.ScreenUpdating = True
End Sub
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Sort by date Sort by votes
Nevermind. I figured it out after stepping away for a bit, and then coming back. I had this closing files:
Code: 
s.Close SaveChanges = False

I should have had this:
Code: 
s.Close SaveChanges:= False
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Copy data from multiple sheets into a master sheet - VBA button stuck
Replies
3
Views
183
NdNoviceHlp
NdNoviceHlp
W
  • Solved
Looking For Tips To Improve My VBA
Replies
8
Views
198
who am i
W
T
  • Question Question
Slow macro
Replies
5
Views
302
topi1
T
M
  • Solved
VBA to delete cells from columns preceding the lowest value in the column
Replies
5
Views
98
DanteAmor
DanteAmor
I
  • Solved
Simplify my working code please
Replies
7
Views
166
ipbr21054
I

Forum statistics

Threads
1,223,903
Messages
6,175,287
Members
452,631
Latest member
a_potato

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top