I need to create a text file, each line of which consists of formatted values taken from 3 different places. I am able to create the file and pass the static variable and user input variables to the file, but I cannot seem to pass the row data from the table to the file.
RoutingNum is a single cell
Chkdate and ChkNum are taken from user input
AcctNum and Amt are from a table <-------------this is the problem.
The table has only two columns
AcctNum and Amt are named ranges in the table.
Each line of the file should look like this:
linetext = _
RoutingNum & _
Format(AcctNum, "00000000000000") & _
Format(ChkDate, "yymmdd") & _
Format(ChkNum, "0000000000") & _
Format(Amt, "00000000")
Here is what I have:
Dim strPath As String
strPath = wsEngine.Range("Path") & _
Format(wsEngine.Range("ChkDate"), "yymmdd") & _
Format(Time(), "hhmmss") & _
".txt"
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.createtextfile(strPath)
linetext = _
RoutingNum & _
Format(AcctNum, "00000000000000") & _
Format(ChkDate, "yymmdd") & _
Format(ChkNum, "0000000000") & _
Format(Amt, "00000000")
For i = 1 To wsAccts.Range("tbldata").Rows.Count
a.WriteLine linetext
Next i
a.Close
I am unable to insert AcctNum or Amt into each line. The rest of linetext is working.
I could use help to loop through the table and insert the cell values from each row into linetext.
Your code needs some modifications as below:
For i = 1 To wsAccts.Range("tbldata").Rows.Count
AcctNum = wsAccts.Range("tbldata").Cells(i, 1).Value 'First column
Amt = wsAccts.Range("tbldata").Cells(i, 2).Value 'Second column
linetext = _
RoutingNum & _
Format(AcctNum, "00000000000000") & _
Format(ChkDate, "yymmdd") & _
Format(ChkNum, "0000000000") & _
Format(Amt, "00000000")
a.WriteLine linetext
Next i
You obviously need to map appropriate variable to fill data from table.
Got it.
I needed to place both linetext, and the variables AcctNum and Amt, inside the loop.
It works perfectly. Thank you.
Related
I have an Excel document containing 2 sheets, 1 import sheet and a data sheet. The dynamic dropdown in Column B of the Import sheet should be dependant on the value chosen in Column A of the import sheet.
However to find the corresponding "Series" I need to match the ID's from the data sheet. (Eicher ID should match the Series Parent ID; Column B and D)
Screenshots down below should explain it better;
I selected Eicher in User Sheet.A3, now I want to retrieve the ID from DataSheet Column B (mmcMake-24046283). With this I need to find all corresponding Series with the same Series Parent ID. So in this case my dropdown should have shown; Series Eicher, Series 2000, Series 3000, Series 300 and Series 400.
Ok, here is a code to insert the validation. Check the "setting variables" part to make sure every variable is properly set. Sorry for the quite complex variables names, but empty stomach makes hard to synthesize. :D
Sub SubDynamicDropdownGenerator()
'Declarations.
Dim StrDataSheetName As String
Dim StrImportSheetName As String
Dim StrImportColumnMake As String
Dim StrDataColumns As String
Dim StrDataColumnSeries As String
Dim StrDataColumnSeriesParentIDEntire As String
Dim BytDataColumnMakesIDInternalColumn As Byte
Dim RngCellWithDropDown As Range
'Setting variables.
StrDataSheetName = "Data" 'Insert here the name of the sheet with data
StrImportSheetName = "Import" 'Insert here the name of the sheet with the import (where the range with the dynamic drowpdown is)
StrImportColumnMake = "A" 'Insert here the letter of the column where labeled Make (according to your first picture it is A)
StrDataColumns = "A:E" 'Insert here the letters of the columns where the data are located in the data sheet (i guess they are A:E)
StrDataColumnSeries = "C" 'Insert here the letter of the column where the Series are located in the data sheet (i guess is the C column)
StrDataColumnSeriesParentIDEntire = "E:E" 'Insert here the address of the column where the Series Parent ID are located in the data sheet (i guess is the E column)
BytDataColumnMakesIDInternalColumn = 2 'Insert here the internal reference of the MakesID in the data sheet for the VLOOKUP functions (since it's in the second column, i set it to 2)
Set RngCellWithDropDown = Sheets(StrImportSheetName).Range("B3") 'Insert here the cell on witch you are going to apply the validation dropdown.
'Setting validation.
With RngCellWithDropDown.Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="=INDIRECT(""" & StrDataSheetName & "!" & StrDataColumnSeries & """&MATCH(VLOOKUP(" & StrImportColumnMake & RngCellWithDropDown.Row & "," & StrDataSheetName & "!" & StrDataColumns & "," & BytDataColumnMakesIDInternalColumn & ",FALSE)," & StrDataSheetName & "!" & StrDataColumnSeriesParentIDEntire & ",0)&"":" & StrDataColumnSeries & """&COUNTIF(" & StrDataSheetName & "!" & StrDataColumnSeriesParentIDEntire & ",VLOOKUP(" & StrImportColumnMake & RngCellWithDropDown.Row & "," & StrDataSheetName & "!" & StrDataColumns & "," & BytDataColumnMakesIDInternalColumn & ",FALSE))+MATCH(VLOOKUP(" & StrImportColumnMake & RngCellWithDropDown.Row & "," & StrDataSheetName & "!" & StrDataColumns & "," & BytDataColumnMakesIDInternalColumn & ",FALSE)," & StrDataSheetName & "!" & StrDataColumnSeriesParentIDEntire & ",0)-1)"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub
Like i've said, it should work as long as the data stay sorted by Series Parent ID. Tell me if you need to appy it on multiple cells. I can edit the code accordingly. Also if you need any explanation on the really messy formula, just say please.
As the title says, I am unable to pass a String parameter through an OnAction that occurs when a checkbox is checked. I have successfully passed two integer values to the sub when the checkbox is checked, but now I need to also pass a String parameter (the String is actually the name of the current Worksheet).
This is currently what it looks like:
'Start of for loop which will run from the lower bound of esq to the upper bound.
For i = LBound(esq) To UBound(esq)
'Inserts a row at the specified location, the current row + 1 + the value of i (0 to 12 depending on which run of the loop it is currently on).
workSource.Rows(rowPos + 1 + i).Insert
'Sets cb as equal to the specified cell in the newly inserted row.
Set cb = workSource.CheckBoxes.Add(Cells(rowPos + 1 + i, colPos + 1).Left, Cells(rowPos + 1 + i, colPos + 1).Top, _
Cells(rowPos + 1 + i, colPos + 1).Width, Cells(rowPos + 1 + i, colPos + 1).Height)
'Start of With which sets the attributes of cb.
With cb
'Sets the caption as the current element of esq.
.Caption = esq(i)
'Links the checkbox with the cell directly beneath it.
.LinkedCell = Cells(rowPos + 1 + i, colPos + 1).Address
'Adds a macro which will be activated when it is clicked. The cell's row and column position will be passed as parameters to the macro.
.OnAction = "'ProcessCheckBox " & rowPos + 1 & "," & colPos + 1 + i & "," & currentName & "'"
'.OnAction = "'" & ThisWorkSheet.Name & "'!ProcessCheckBox"
'.OnAction = "'ProcessCheckBox " & rowPos + 1 & "," & colPos + 1 + i & "," & """SES""" & "'"
'.OnAction = "'ProcessCheckBox " & currentName & "'"
'End of With.
End With
'Starts next run of loop and increments i.
Next i
There are three commented out lines of OnAction that I attempted to experiment with in order to get just the string to be passed. Unfortunately, none of them worked. Here is the start of the code for the ProcessCheckBox sub:
'Sub to process when a checkbox has been changed.
Sub ProcessCheckBox(ByVal rowPos As Integer, ByVal colPos As Integer, ByVal currentSheet As String)
'Sub ProcessCheckBox(ByVal currentSheet As String)
MsgBox currentSheet
'Declares a worksheet object named currentSheet.
Dim activeSheet As Worksheet
'Sets currentSheet equal to the active worksheet.
Set activeSheet = ThisWorkbook.Worksheets(currentSheet)
'Set currentSheet = ActiveSheet
After clicking the checkbox, a msgbox appears that is completely blank, and then I run into an error where it says the subscript is out of range.
I gather from this that the sub is being called, the String value is just not being passed along. The string value in the first sub (currentName) does have a value, as I can print it out and use it for calculations just fine.
I think the problem is in the OnAction line itself. It took me a while to figure out how to pass the integer values due to not knowing the correct number of single and double quotes to use. I think it has to do with this, however, all of the other examples I saw passed String values like this. I even experimented by adding or removing quotes just to see if it would work out and nothing.
Other errors I thought it might be: a sub has a limit to how many/large parameters can be passed to it, only parameters of a single type can be passed (either String or Integer). Neither of these make sense because I have encountered many examples that pass much more data across many different types to a sub.
Thank you to the people who answered, but neither of the solutions offered worked. I've been testing the macro and it appears no matter what I do, it will not pass a string as a parameter, either alone or with other parameters. I don't know why.
Here are the two lines in question I have narrowed it down to :
.OnAction = "'ProcessCheckBox " & colPos + 1 & "," & rowPos + 1 + i & ",""" & nameSheet & """'"
And the first line of the sub :
Sub ProcessCheckBox(ByVal colPos As Integer, ByVal rowPos As Integer, ByVal sheetName As String)
Ticking the checkbox gives me an error saying "Argument Not Optional." However, it doesn't allow me to go into debug mode, and it doesn't highlight the specific line either, although I have tested it and believe these two lines to be the problem.
I've given up on figuring VBA's single and double quotes and acknowledge that I never needed anything to be passed as argument that wasn't available in the workbook in which the check box resides. Therefore I can easily get all the information I might want to pass directly from the worksheet.
Where that may not be enough, I also get access to the CheckBox object itself. All my needs for arguments can be satisfied completely without any quotation marks.
Private Sub CheckBox1_Click()
Dim ChkBox As Shape
Set ChkBox = ActiveSheet.Shapes(Application.Caller)
MsgBox ChkBox.Parent.Name & vbcr & _
ChkBox.OLEFormat.Object.Name
End Sub
Here are 3 possible solutions for your problem, all involving the Application.Caller.
Please run this code on your project.
Sub CheckBox1_Click()
Dim ChkBox As Shape
Dim WsName As String, Rpos As Long, Cpos As Long
Dim Cell As Range
' Solution 1
WsName = ActiveSheet.Shapes(Application.Caller).OLEFormat.Object.Parent.Name
MsgBox "You already know how to pass the cell coordinates" & vbCr & _
"Just get the Sheet name from here:" & vbCr & _
"Sheet name is """ & WsName & """"
Set ChkBox = ActiveSheet.Shapes(Application.Caller)
' Solution 2
Set Cell = ChkBox.OLEFormat.Object.TopLeftCell
Rpos = Cell.Row
Cpos = Cell.Column
WsName = Cell.Worksheet.Name
MsgBox "Solution 2" & vbCr & _
"The checkbox Top Left is aligned with the" & vbCr & _
"Linked Cell's Top Left:-" & vbCr & _
"Row number = " & Rpos & vbCr & _
"Column number = " & Cpos & vbCr & _
"Worksheet name = " & WsName & vbCr & _
"If Alignment of underlying cell and TopLeft" & vbCr & _
"isn't perfect, modify the placement in your other code." & vbCr & _
"Here is the TopLeft address:-" & vbCr & _
"TopLeftCell address = " & Cell.Address
' Solution 3
Set Cell = Range(ChkBox.OLEFormat.Object.LinkedCell)
Rpos = Cell.Row
Cpos = Cell.Column
WsName = Cell.Worksheet.Name
MsgBox "Solution 3" & vbCr & _
"Get the information directly from the Linked Cell." & vbCr & _
"(This is probably the one you are interested in):-" & vbCr & _
"Row number = " & Rpos & vbCr & _
"Column number = " & Cpos & vbCr & _
"Worksheet name = " & WsName & vbCr & _
"This method might fail if the linked cell" & vbCr & _
"is altered, perhaps manually."
End Sub
I created a function in Excel VBA:
Function codeList(Criteria As String, LookupRange As Range, ValueRange As Range, delimiter As String)
It works great when I pass hard coded ranges to it like this:
ActiveCell.FormulaR1C1 = "=codelist(RC[2],R2C4:R84C4,R2C3:R84C3,"","")"
I would like the rows to be dynamic, so instead of saying C2:C84 or D2:D84 I would like to make the C84 / D84 vary based on the number of columns that have data.
I tried to compute the last row and concatenate the ranges to make them dynamic when I call the function, but I get a compile syntax error :
Dim lastRow As Long
lastRow = Range("C" & Rows.Count).End(xlUp).Row
ActiveCell.FormulaR1C1 = "=codelist(RC[2],"R2C4:R" & lastrow &"C4", "R2C3:R" & lastrow & "C3"),"","")"
Any suggestions on how to make this work?
When you want to include double quotes inside a string, you have to use two double quotes to escape them.
ActiveCell.FormulaR1C1 = "=codelist(RC[2],R2C4:R" & lastRow & "C4, R2C3:R" & lastRow & "C3,"""")"
The four double quotes near the end convert to two double quotes (the empty string your looking for).
This way is longer, but I tend to use offsets in formulas. I find it easier to read than trying to determine where the strings begin and end
Const DBLQTE As String = """"""
ActiveCell.FormulaR1C1 = "=codelist(RC[2]," & _
Range("D2").Resize(lastRow - 1).Address(, , xlR1C1) & _
"," & _
Range("C2").Resize(lastRow - 1).Address(, , xlR1C1) & _
"," & _
DBLQTE & _
")"
Update
For a comma delimeter
ActiveCell.FormulaR1C1 = "=codelist(RC[2],R2C4:R" & lastRow & "C4, R2C3:R" & lastRow & "C3,"","")"
and
Const COMMA As String = ""","""
ActiveCell.FormulaR1C1 = "=codelist(RC[2]," & _
Range("D2").Resize(lastRow - 1).Address(, , xlR1C1) & _
"," & _
Range("C2").Resize(lastRow - 1).Address(, , xlR1C1) & _
"," & _
COMMA & _
")"
Qualify the parent worksheet and resize according to the column's populated limit. Resize every associated range that needs to be the same size.
Function codeList(Criteria As String, LookupRange As Range, ValueRange As Range, delimiter As String)
with LookupRange.parent
set LookupRange = .range(LookupRange.cells(1), .cells(.rows.count, LookupRange.cells(LookupRange.cells.count).column).end(xlup))
set ValueRange = ValueRange.cells(1).resize(LookupRange.rows.count, LookupRange.columns.count)
end with
'all the rest of the code
end function
Never use ActiveSheet or ActiveCell in a worksheet's UDF. The originating cell where the formula is in is the Application.Caller.
First off, I know there's a million questions about formatting dates, but I have not found a solution that works with my situation.
We are given a .csv file, and due to requirements, we must modify the file in a couple of ways.
Firstly, we run a VBA on the file in order to change the delimiter from "," to "|" (we have this working) using:
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\Users\Z00393885\Desktop\csvStuff\"&myVar, ForReading)
count = 0
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
strReplacer = Chr(34) & "," & Chr(34)
strLine = Replace(strLine, strReplacer, "|")
strLine = Replace(strLine, chr(34), "")
strNewText = strNewText & strLine & vbCrLF
count = count + 1
Loop
Print (count - 1)
objFile.Close
Set objFile = objFSO.OpenTextFile("C:\Users\Z00393885\Desktop\csvStuff\"&myVar, ForWriting)
objFile.WriteLine "BOF" & vbCrLF & now() & vbCrLF & (count - 1) & vbCrLF & strNewText & "EOF"
objFile.Close
The second requirement is the one that's giving me trouble, I have to look for every Date that is present (they are formatted: 11/8/2017 1:30 EST and lie within the 10th and 11th columns) and format the date so that it would be 11/08/2017 (we need to remove the Time as well as make sure that the day and month has a 0 if its only a single digit)
Is this doable within the Do Until loop? or would it be better to have a separate function to take care of that part. Either way, I am not even sure where to start with manipulating Dates within a file like this and not just a variable
EDIT: here is some of the .csv file
BOF
11/1/2017 12:08:21 PM
3
Course Code|Home Org|...|Release Date|Effective Date|...|Web Address
123|TAD Sites|...|10/31/2017 00:00:00 EDT|11/14/2017 00:00:00 EDT|...|http://URL
456|DAT Sites|...|11/5/2017 00:00:00 EDT|11/5/2017 00:00:00 EDT|...|http://URL
EOF
One thing you could do is split the original line into the columns, then you only need to consider the 10th and 11th columns:
Dim myArray() As String
'...
strLine = objFile.ReadLine
'Current delimiter is quote-comma-quote
strReplacer = Chr(34) & "," & Chr(34)
'Replace current delimiter with a pipe delimiter
strLine = Replace(strLine, strReplacer, "|")
'Remove any remaining quote marks
strLine = Replace(strLine, Chr(34), "")
'Split line using pipe delimiter
myArray = Split(strLine, "|")
'Convert column 10
myArray(9) = Format(CDate(Left(myArray(9), InStr(myArray(9), " ") - 1)), "mm/dd/yyyy")
'Convert column 11
myArray(10) = Format(CDate(Left(myArray(10), InStr(myArray(10), " ") - 1)), "mm/dd/yyyy")
'Join line back together with pipe delimiter
strLine = Join(myArray, "|")
'Create one huge string containing all lines in file
strNewText = strNewText & strLine & vbCrLF
'...
To use this as VBScript will require a few minor changes:
'Dim myArray() As String
Dim myArray
'...
strLine = objFile.ReadLine
'Current delimiter is quote-comma-quote
strReplacer = Chr(34) & "," & Chr(34)
'Replace current delimiter with a pipe delimiter
strLine = Replace(strLine, strReplacer, "|")
'Remove any remaining quote marks
strLine = Replace(strLine, Chr(34), "")
'Split line using pipe delimiter
myArray = Split(strLine, "|")
'Convert column 10
'myArray(9) = Format(CDate(Left(myArray(9), InStr(myArray(9), " ") - 1)), "mm/dd/yyyy")
myArray(9) = FormatDateTime(CDate(Left(myArray(9), InStr(myArray(9), " ") - 1)), 0)
'Convert column 11
'myArray(10) = Format(CDate(Left(myArray(10), InStr(myArray(10), " ") - 1)), "mm/dd/yyyy")
myArray(10) = FormatDateTime(CDate(Left(myArray(10), InStr(myArray(10), " ") - 1)), 0)
'Join line back together with pipe delimiter
strLine = Join(myArray, "|")
'Create one huge string containing all lines in file
strNewText = strNewText & strLine & vbCrLF
'...
I don't use VBScript myself, but I believe the FormatDateTime function will give you what you want as output. It seems to be locale-specific, but I assume you use mm/dd/yyyy format as standard in your location.
Have you thought about running a "text to column" function, simply altering the formats to the date columns, then outputting the file? This might be a lot easier than searching for characters and altering them the way you are doing.
With Range(pass the range here)
.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(..., ...),_
TrailingMinusNumbers:=True
Columns("x:x").NumberFormat = "mm/dd/yyyy"
From here you can save the file.
EDIT:
One caveat: you need to hard code the number of columns you will end up with into the array.
For example, if each row of the file contains 4 sections, you would use:
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
I am having trouble debugging a code I wrote. It runns fine until a certain point and then stops and shows: runtime error 1004 application-defined or object-defined error.
I have not written VBA in a very long time so my code might be a mess =).
The problem seems to be with: see comment 'Generate UID for the Current Imp
'Sheet Definitions
strSourceSheet = "MasterReport"
strComponentSheet = "UniqueIdComponents"
'defines row where data starts
intEntryCount = 2
intImpCount = 0
'determine maximum number of rows for both sheets
lngMaxRowSS = ThisWorkbook.Sheets(strSourceSheet).UsedRange.SpecialCells(xlCellTypeLastCell).Row
lngMaxRowCS = ThisWorkbook.Sheets(strComponentSheet).UsedRange.SpecialCells(xlCellTypeLastCell).Row
'Run until there are no more entries
For intEntryCount = 2 To lngMaxRowSS
'Prevents to overwrite existing UIDs
If ThisWorkbook.Sheets(strSourceSheet).Range("BP" & intEntryCount) = "" Then
'Recieve next imperative on the Source List to find according UID Components
strSourceImperative = ThisWorkbook.Sheets(strSourceSheet).Range("A" & intEntryCount)
'Run until no new Imp UID is defind
For intImpCount = 11 To lngMaxRowCS
'Location of Imps on Component Sheet
strComponentImperative = ThisWorkbook.Sheets(strComponentSheet).Range("C" & intImpCount)
' If the Source Imp = Component Imp then we create a UID for that Source IP
If strSourceImperative = strComponentImperative Then
'Assign Column to UID component in order to find the Column in the MasterReport
strUIDComponent1 = ThisWorkbook.Sheets(strComponentSheet).Range("D" & intImpCount)
strUIDComponent2 = ThisWorkbook.Sheets(strComponentSheet).Range("E" & intImpCount)
strUIDComponent3 = ThisWorkbook.Sheets(strComponentSheet).Range("F" & intImpCount)
strUIDComponent4 = ThisWorkbook.Sheets(strComponentSheet).Range("G" & intImpCount)
strUIDComponent5 = ThisWorkbook.Sheets(strComponentSheet).Range("H" & intImpCount)
strUIDComponent6 = ThisWorkbook.Sheets(strComponentSheet).Range("I" & intImpCount)
strUIDComponent7 = ThisWorkbook.Sheets(strComponentSheet).Range("J" & intImpCount)
'Generate UID for the Current Imp
strUID = ThisWorkbook.Sheets(strSourceSheet).Range(strUIDComponent1 & intEntryCount) _
& ThisWorkbook.Sheets(strSourceSheet).Range(strUIDComponent2 & intEntryCount) _
& ThisWorkbook.Sheets(strSourceSheet).Range(strUIDComponent3 & intEntryCount) _
& ThisWorkbook.Sheets(strSourceSheet).Range(strUIDComponent4 & intEntryCount) _
& ThisWorkbook.Sheets(strSourceSheet).Range(strUIDComponent5 & intEntryCount) _
& ThisWorkbook.Sheets(strSourceSheet).Range(strUIDComponent6 & intEntryCount) _
& ThisWorkbook.Sheets(strSourceSheet).Range(strUIDComponent7 & intEntryCount)
'Writes UID into MasterReport
'ThisWorkbook.Sheets(strSourceSheet).Range("BP" & intEntryCount) = strUID
'Test Writes
ThisWorkbook.Sheets("Test").Range("A" & intEntryCount) = strUID
'If the Source Imp = Component Imp then we created a UID for that Source IP
End If
'If the two Source Imp <> Component Imp, go to next row on Component sheet and compare again
Next intImpCount
'Prevented to overwrite existing UIDs
End If
Next intEntryCount
In the case where i get the error the components are A,M,N,O,BK,"","" and the Entry count is 5718. It wrote 5718 entries just fine and then shows the Error.
Any Ideas?
Thanks in advance for your help!!
Taking ThisWorkbook.Sheets(strSourceSheet) out to a With statement and substituting values, you appear to be saying this statement is equivalent to:
With ThisWorkbook.Sheets(strSourceSheet)
strUID = .Range("A" & 5718) & _
.Range("M" & 5718) _
.Range("N" & 5718) _
.Range("O" & 5718) _
.Range("BK" & 5718) _
.Range("" & 5718) _
.Range("" & 5718)
End With
The last two entries are not valid ranges.
I cannot test this code but something like this might meet your requirements:
Dim WkShtComp As Worksheet
Dim WkShtSrc As Worksheet
Dim ColMast As String
With ThisWorkbook
Set WkShtComp = .Sheets(strComponentSheet)
Set WkShtSrc = .Sheets(strSourceSheet)
End With
strUID = ""
For Each ColMast in Array("D", "E", "F", "G", "H", "I", "J")
strUIDComponent = WKShtComp.Range(ColMast & intImpCount).Value
If strUIDComponent <> "" Then
strUID = strUID & WkShtSrc.Range(strUIDComponent & intEntryCount).Value
Endif
Next