I am trying to combine Data from multiple columns in different worksheets into a single column via vbscript.
My Data looks something like this:
Workbook: C:\myworkbook.xlsx
After running my script: Cleaned Data
What I need help with - turning the 4 cleaned columns into a single one: Needed result
So here is the code. Everything works except gathering the columns with the cleaned data and combining them to a single column.
Set dropfile = Wscript.Arguments 'Dropped File
Set xlApp = CreateObject("Excel.Application")
xlApp.visible = true
Current_Date = Date
xlApp.Workbooks.Open(dropfile(0))
Set xlApp = xlApp
Set Sheet1 = xlApp.worksheets("Sheet1")
Set xlWb = xlApp.ActiveWorkbook
Set xlWs = xlWb.ActiveSheet
'Create new Sheet "Sheet 2" - contains copied Data from Sheet1 column A. Script to clean it add a path Z:... Copied original data in column A, cleaned Data in Column B
Set xlWs = xlWb.Worksheets.Add(, xlWb.Worksheets(xlWb.Worksheets.Count))
'Name
xlWs.Name = "Sheet2"
Set Sheet2 = xlApp.worksheets("Sheet2")
'Create new Sheet "Sheet 3" - contains copied Data from Sheet1 column A. Script to clean it add a path S:... Copied original data in column A, cleaned Data in Column B
Set xlWs = xlWb.Worksheets.Add(, xlWb.Worksheets(xlWb.Worksheets.Count))
'Name
xlWs.Name = "Sheet3"
Set Sheet3 = xlApp.worksheets("Sheet3")
'Create new Sheet "Sheet 4" - contains copied Data from Sheet1 column B. Script to clean it add a path Z:... Copied original data in column A, cleaned Data in Column B
Set xlWs = xlWb.Worksheets.Add(, xlWb.Worksheets(xlWb.Worksheets.Count))
'Name
xlWs.Name = "Sheet4"
Set Sheet4 = xlApp.worksheets("Sheet4")
'Create new Sheet "Sheet 5" - contains copied Data from Sheet1 column B. Script to clean it add a path P:... Copied original data in column A, cleaned Data in Column B
Set xlWs = xlWb.Worksheets.Add(, xlWb.Worksheets(xlWb.Worksheets.Count))
'Name
xlWs.Name = "Sheet5"
Set Sheet5 = xlApp.worksheets("Sheet5")
'Create new Sheet "Sheet 6"- contains the 4 cleaned columns from Sheet 2-5
Set xlWs = xlWb.Worksheets.Add(, xlWb.Worksheets(xlWb.Worksheets.Count))
'Name
xlWs.Name = "Sheet6"
Set Sheet6 = xlApp.worksheets("Sheet6")
'Create new Sheet "Sheet 7"- should contain a single column A combining the 4 cleaned columns from Sheet 5. The sheet will then be saved as .txt for further works outside Excel/VBS.
Set xlWs = xlWb.Worksheets.Add(, xlWb.Worksheets(xlWb.Worksheets.Count))
'Name
xlWs.Name = "Sheet7"
Set Sheet7 = xlApp.worksheets("Sheet7")
Const xlCellTypeBlanks = 4 'Delete blank cells
'Sheet1 Some text and formating going on
With Sheet1
.Cells(2, 1) = "A Text to be inserted here"
.Cells(1, 4) = "Another Text"
.Cells(1, 5) = "John Doe"
.Columns("A:A").ColumnWidth = 20
.Columns("B:B").ColumnWidth = 85
.Columns("C:C").ColumnWidth = 18
.Columns("D:D").ColumnWidth = 35
.Columns("E:E").ColumnWidth = 30
.Range("E1").Font.Color = vbRed
.Range("A2").Font.Bold = False
.Rows(4).EntireRow.Delete
.Rows(4).EntireRow.Delete
End With
'Copy column A and paste to sheet2
Sheet1.Range("A:A").EntireColumn.Copy
Sheet2.Paste Sheet2.Range("A1")
'Copy column A and paste to sheet3
Sheet1.Range("A:A").EntireColumn.Copy
Sheet3.Paste Sheet3.Range("A1")
'Copy column B and paste to sheet4
Sheet1.Range("B:B").EntireColumn.Copy
Sheet4.Paste Sheet4.Range("A1")
'Copy column and paste to sheet5
Sheet1.Range("B:B").EntireColumn.Copy
Sheet5.Paste Sheet5.Range("A1")
'Sheet2: do some cleanup & replacements to column A
with Sheet2
.Range("A:A").Replace "_b.*", "*"
.Range("A:A").Replace "_d.*", "*"
.Range("A:A").Replace "_a.*", "*"
.Range("A:A").Replace "_b.*", "*"
.Range("A:A").Replace "_v.*", "*"
.Range("A:A").Replace "Filename*", ""
.Range("A:A").Replace "A Title*", ""
.Range("A:A").Replace "A Text to be inserted here", ""
End with
'Sheet2 delete empty cells
sheet2.Columns("a:a").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Sheet2: copy column A to B and add a filepath
Dim complementSheet2 'Var sheet2 column B wih supplemented filepath
Dim FilenameSheet2 'Var sheet2 column A with filenames
Dim lastrowSheet2 'last row with data)
Dim iTab2 '1. row Sheet2
lastrowSheet2 = sheet2.Range("A65536").End(-4162).Row
Set complementSheet2 = sheet2.Range("B1",sheet2.Cells(lastrowSheet2, 22))
Set FilenameSheet2 = sheet2.Range("A1",sheet2.Cells(lastrowSheet2, 22))
For iTab2 = 1 to lastrowSheet2
If FilenameSheet2.Cells(iTab2,1).Value = FilenameSheet2.Cells(iTab2,1).Value Then
complementSheet2.Cells(iTab2,1).Value = "Z:\*" & FilenameSheet2.Cells(iTab2,1).Value
Else
complementSheet2.Cells(iTab2,1).Value = ""
End If
Next
'Sheet3: do some cleanup & replacements to column A
with Sheet3
.Range("A:A").Replace "_b.*", "*"
.Range("A:A").Replace "_d.*", "*"
.Range("A:A").Replace "_a.*", "*"
.Range("A:A").Replace "_b.*", "*"
.Range("A:A").Replace "_v.*", "*"
.Range("A:A").Replace "Filename*", ""
.Range("A:A").Replace "A Title*", ""
.Range("A:A").Replace "A Text to be inserted here", ""
End with
'Sheet3 delete empty cells
sheet3.Columns("a:a").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Sheet3: copy column A to B and add a filepath
Dim complementSheet3 'Var sheet3 column B wih supplemented filepath
Dim FilenameSheet3 'Var sheet3 column A with filenames
Dim lastrowSheet3 'last row with data)
Dim iTab3 '1. row Sheet3
lastrowSheet3 = sheet3.Range("A65536").End(-4162).Row
Set complementSheet3 = sheet3.Range("B1",sheet3.Cells(lastrowSheet3, 22))
Set FilenameSheet3 = sheet3.Range("A1",sheet3.Cells(lastrowSheet3, 22))
For iTab3 = 1 to lastrowSheet3
If FilenameSheet3.Cells(iTab3,1).Value = FilenameSheet3.Cells(iTab3,1).Value Then
complementSheet3.Cells(iTab3,1).Value = "P:\*" & FilenameSheet2.Cells(iTab3,1).Value
Else
complementSheet3.Cells(iTab3,1).Value = ""
End If
Next
'Sheet4: do some cleanup & replacements to column A
with Sheet4
.Range("A:A").Replace " ", ""
.Range("A:A").Replace "/", ""
.Range("A:A").Replace ".", ""
.Range("A:A").Replace "Filename*", ""
.Range("A:A").Replace "A Title*", ""
End with
'Sheet4 delete empty cells
sheet4.Columns("a:a").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Sheet4: copy column A to B and add a filepath
Dim complementSheet4 'Var sheet4 column B wih supplemented filepath
Dim FilenameSheet4 'Var sheet4 column A with filenames
Dim lastrowSheet4 'last row with data)
Dim iTab4 '1. row Sheet3
lastrowSheet4 = sheet4.Range("A65536").End(-4162).Row
Set complementSheet4 = sheet4.Range("B1",sheet4.Cells(lastrowSheet4, 22))
Set FilenameSheet4 = sheet4.Range("A1",sheet4.Cells(lastrowSheet4, 22))
For iTab4 = 1 to lastrowSheet4
If FilenameSheet4.Cells(iTab4,1).Value = FilenameSheet4.Cells(iTab4,1).Value Then
complementSheet4.Cells(iTab4,1).Value = "Z:\*" & FilenameSheet4.Cells(iTab4,1).Value & "*"
Else
complementSheet4.Cells(iTab4,1).Value = ""
End If
Next
'Sheet5: do some cleanup & replacements to column A
with Sheet5
.Range("A:A").Replace " ", ""
.Range("A:A").Replace "/", ""
.Range("A:A").Replace ".", ""
.Range("A:A").Replace "Filename*", ""
.Range("A:A").Replace "A Title*", ""
End with
'Sheet5 delete empty cells
sheet5.Columns("a:a").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Sheet5: copy column A to B and add a filepath
Dim complementSheet5 'Var sheet5 column B wih supplemented filepath
Dim FilenameSheet5 'Var sheet5 column A with filenames
Dim lastrowSheet5 'last row with data)
Dim iTab5 '1. row Sheet3
lastrowSheet5 = sheet5.Range("A65536").End(-4162).Row
Set complementSheet5 = sheet5.Range("B1",sheet5.Cells(lastrowSheet5, 22))
Set FilenameSheet5 = sheet5.Range("A1",sheet5.Cells(lastrowSheet5, 22))
For iTab5 = 1 to lastrowSheet5
If FilenameSheet5.Cells(iTab5,1).Value = FilenameSheet4.Cells(iTab5,1).Value Then
complementSheet5.Cells(iTab5,1).Value = "P:\*" & FilenameSheet5.Cells(iTab5,1).Value & "*"
Else
complementSheet5.Cells(iTab5,1).Value = ""
End If
Next
'next step is probalby uneccessary?
'Copy the cleaned columns from sheet 2-5 and paste in sheet6
sheet2.Range("B:B").EntireColumn.Copy
sheet6.Paste sheet6.Range("A1")
sheet3.Range("B:B").EntireColumn.Copy
sheet6.Paste sheet6.Range("B1")
sheet4.Range("B:B").EntireColumn.Copy
sheet6.Paste sheet6.Range("C1")
sheet5.Range("B:B").EntireColumn.Copy
sheet6.Paste sheet6.Range("D1")
'now all 4 cleaned columns should be merged into a single column- but how?
'Create TXT-File with cleaned Data in Sheet6
with sheet7
xlWb.SaveAs "C:\filelist.txt", -4158
end with