So I have received some awesome guidance with codes and directions to try as I continue to learn and grow in VBA and Macros. I recorded a physical macro which preps and cleans up data from a data file then imports specific columns of data to my workbook.
I was thinking it might be cleaner to break it into two macros and I also want to stop using a hard row number and instead use a row count or something to get only the cells in the columns that are used.
Also, I don't know if this is possible, but I was hoping to make the file location be a reference to a cell so If I were to use a different location I could just paste in the location of the file into cell "..." on a reference sheet or something like that.
Anyway, below is what I'm starting with, I am also posting what I tried but I am getting errors and it didn't like my row counts either. Maybe someone can help or direct me to my many errors.
Thanks in advance
This is current working code:
These are the two I tried to create so I could simply "Call" the two macros:
I was thinking it might be cleaner to break it into two macros and I also want to stop using a hard row number and instead use a row count or something to get only the cells in the columns that are used.
Also, I don't know if this is possible, but I was hoping to make the file location be a reference to a cell so If I were to use a different location I could just paste in the location of the file into cell "..." on a reference sheet or something like that.
Anyway, below is what I'm starting with, I am also posting what I tried but I am getting errors and it didn't like my row counts either. Maybe someone can help or direct me to my many errors.
Thanks in advance
This is current working code:
Code:
Sub ImportAllData()
' ImportData Macro
' This section removed duplicates
WaitingMsg.Show
Application.ScreenUpdating = False
Workbooks.Open Filename:="I:\Location\1.xls"
Range("F2:F65536").Select
Selection.TextToColumns Destination:=Range("F2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 9), Array(10, 1)), TrailingMinusNumbers:=True
ActiveSheet.Range("$A$1:$AJ$600").RemoveDuplicates Columns:=Array(2, 3), _
Header:=xlYes
Application.DisplayAlerts = False
' Sort1 Macro
Range("I1").Select
ActiveWorkbook.Worksheets("1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("1").Sort.SortFields.Add Key:=Range("I1"), SortOn _
:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("1").Sort
.SetRange Range("A2:K600")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
' This section copies the data and pastes into the Workbook
Range("A2:C61").Select
Selection.Copy
Windows("Qlty Workbook Daily1").Activate
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("1.xls").Activate
Range("F2:K61").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Qlty Workbook Daily1").Activate
Range("I3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("1.xls").Activate
Application.CutCopyMode = False
ActiveWindow.Close SaveChanges:=False
Application.DisplayAlerts = False
Windows("Qlty Workbook Daily1").Activate
Range("D3").Select
Unload WaitingMsg
End With
End Sub
These are the two I tried to create so I could simply "Call" the two macros:
Code:
Sub ImportAllDataPrep()
' ImportData Macro
' This section removed duplicates
WaitingMsg.Show
Application.ScreenUpdating = False
Workbooks.Open Filename:="I:\Location\1.xls"
Range("F2" & Rows.Count).Select
Selection.TextToColumns Destination:=Range("F2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 9), Array(10, 1)), TrailingMinusNumbers:=True
ActiveSheet.Range("A" & Rows.Count).RemoveDuplicates Columns:=Array(2, 3), _
Header:=xlYes
Application.DisplayAlerts = False
' Sort1 Macro
Range("I1").Select
ActiveWorkbook.Worksheets("1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("1").Sort.SortFields.Add Key:=Range("I1"), SortOn _
:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("1").Sort
.SetRange Range("A2" & Rows.Count)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End Sub
Code:
Sub ImportAllData()
WaitingMsg.Show
' This section copies the data and pastes into the Workbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim Wbk As Workbook
Dim Mws As Worksheet, Nws As Worksheet
Set Mws = ThisWorkbook.Sheets("Today")
Set Wbk = Workbooks.Open("I:\Location\1.xlsm")
With Wbk.[A1].CurrentRegion
Union(.Columns("A:C")).Offset(1).Copy
Mws.Range("D3").End(3)(2).PasteSpecial xlValues
With Wbk.[A1].CurrentRegion
Union(.Columns("F:K")).Offset(1).Copy
Mws.Range("I3").End(3)(2).PasteSpecial xlValues
Wbk.Close True
Windows("1.xls").Activate
Application.CutCopyMode = False
ActiveWindow.Close SaveChanges:=False
Application.DisplayAlerts = False
Windows("Qlty Workbook Daily1").Activate
Range("D3").Select
Unload WaitingMsg
End With
End Sub