Text To Columns Causing File Save?

R

reberryjr

Well-known Member
Joined
Mar 16, 2017
Messages
701
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

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
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

A
  • Solved
copy paste from one worksheet to other but in different columns
2
Replies
18
Views
747
Joe4
Joe4
L
  • Solved
VBA Error
2 3
Replies
29
Views
296
Joe4
Joe4
T
  • Question
This is so slow I have to run it overnight
Replies
4
Views
249
kevin9999
K
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
2
Views
241
B-radK
B
K
  • Question
Paste Data Below last row
Replies
3
Views
244
rlv01
R

Forum statistics

Threads
1,215,206
Messages
6,123,636
Members
449,109
Latest member
Sebas8956

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