Hello All! As always, many thanks for all your past help!! I have tried and tried, and for my life, I cannot figure out why the code below is not working correctly. As written, it works flawlessly. I need to exclude anything starting with "8" in column B. Runs like a charm - but now I need also to exclude anything starting with a "9". When I add this to the query, I get no data, but when I run it manually, it works. There can be hundreds of rows of data. Below is a small sampling and the current code. Any suggestions would be most appreciated!
| Date | NBR | Info |
| 07/07/24 | 547 | 578R |
| 07/08/24 | 578 | 4589 |
| 07/07/24 | 001 | 1234 |
| 07/07/24 | 002 | 1256 |
| 07/07/24 | 003 | 578R |
| 07/08/24 | 004 | 4589 |
| 07/07/24 | 005 | 1234 |
| 07/07/24 | 006 | 1256 |
| 07/07/24 | 007 | 578R |
| 07/08/24 | 008 | 4589 |
| 07/07/24 | 009 | 1234 |
| 07/07/24 | 010 | 1256 |
| 07/07/24 | 011 | 578R |
| 07/08/24 | 012 | 4589 |
| 08/14/24 | 900 | 1234 |
| 08/14/24 | 901 | 1235 |
| 08/14/24 | 801 | 6789 |
| 08/14/24 | 802 | 0123 |
VBA Code:
Sub codes()
' Select File
Dim myfile As Variant
myfile = Application.GetOpenFilename( _
FileFilter:="Text Files (*.lin), *.lin", _
Title:="Select text file", _
ButtonText:="Open")
If myfile = False Then Exit Sub
Dim my_workbook As Workbook, my_worksheet As Worksheet
' First digit in array is character and 2nd is format.
Workbooks.OpenText Filename:=myfile, _
Origin:=437, StartRow:=6, DataType:=xlFixedWidth, FieldInfo:=Array( _
Array(0, 2), Array(9, 2), Array(13, 2), Array(18, 2)) _
, TrailingMinusNumbers:=True
Set my_workbook = ActiveWorkbook
Set my_worksheet = my_workbook.Sheets(1)
With my_worksheet
.Columns("D").EntireColumn.Delete
.Columns("A:C").Select
Application.CutCopyMode = False
.ListObjects.Add(xlSrcRange, .Range("$A:$C"), , xlNo).Name = "Table1"
' Create Query
.Columns("A:C").Select
.Parent.Queries.Add Name:="Table1", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Excel.CurrentWorkbook(){[Name=""Table1""]}[Content]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Source,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}})," & Chr(13) & "" & Chr(10) & " #""Filtered Rows"" = Table.SelectRows(#""Changed Type"", each [Column2] <> null and [Column2] <> """")," & Chr(13) & "" & Chr(10) & " #""Filtered Rows1"" = Table.SelectRows(#""F" & _
"iltered Rows"", each not Text.StartsWith([Column2], ""8""))," & Chr(13) & "" & Chr(10) & " #""Filtered Rows2"" = Table.SelectRows(#""Filtered Rows1"", each ([Column2] <> ""-05"" and [Column2] <> ""H IN"" and [Column2] <> ""NBR""))" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Filtered Rows2"""
End With
Dim second_sheet As Worksheet
Set second_sheet = my_workbook.Worksheets.Add
With second_sheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Table1;Extended Properties=""""" _
, Destination:=second_sheet.Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table1]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table1_2"
my_workbook.RefreshAll
End With
' Copy and Paste_into_new_sheet
Dim lastRow As Long, CopyRange As Range
Dim PasteWorkbook As Workbook, PasteSheet As Worksheet, PasteRange As Range
With second_sheet
lastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
Set CopyRange = .Range(.Cells(2, 1), .Cells(lastRow, 3))
End With
MsgBox "LastRow: " & lastRow & ", and CopyRange: " & CopyRange.Address
Set PasteWorkbook = Workbooks.Open(Filename:= _
"https://company-my.sharepoint.com/personal/myname_company_com/Documents/Desktop/file2.xlsm")
'Set PasteWorkbook = Workbooks.Add ' For testing
Set PasteSheet = PasteWorkbook.Sheets(1) ' YOU MIGHT NEED TO CHANGE THIS
CopyRange.Copy Destination:=PasteSheet.Range("A5")
End Sub
