Home |
Search |
Today's Posts |
#1
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
I am using the following code to insert missing rows of alphanumeric values. While it does work it is removing the leading zeros as shown below...
I have tried playing the the cell formats, with no sucess, Any ideas how to correct this behavior??? Also how can I add the ability to verify the number sequence will start at LxxD159 & LxxM159 respectively, where xx ranges from 1 to 10 (this could get the value from another worksheet.) L01D001 L01D002 L01D003 L01D159 L01M001 L01M002 L01M3 <---- L01M4 <---- L01M005 Sub test() Dim val1 As String, txt1 As String, xNum As Long Dim WorkRows As Long, _ Ndx As Long, _ Diff As Long, _ InsertCounter As Integer, _ WorkColumn As String WorkColumn = "A" ' <<<<<<< CHANGE TO YOUR COLUMN WorkRows = Cells(Rows.Count, WorkColumn).End(xlUp).Row 'Starting Len Value xNum = 5 'Start at the bottom of the list and work up to the top 'that way ndx will always poin to the row just above the ones 'that were inserted For Ndx = WorkRows To 2 Step -1 Cells(Ndx, WorkColumn).Activate val1 = Selection.Cells(1).Value txt1 = Left(val1, xNum - 1) 'establish the rows to insert val1 = Right(Selection.Cells(1).Value, Len(Selection.Cells(1).Value) - xNum + 1) Diff = Right(Cells(Ndx, WorkColumn).Value, Len(Cells(Ndx, WorkColumn).Value) - xNum + 1) - Right(Cells(Ndx - 1, WorkColumn).Value, Len(Cells(Ndx - 1, WorkColumn).Value) - xNum + 1) If Diff 1 Then For InsertCounter = 1 To Diff - 1 Range(WorkColumn & Ndx).EntireRow.Insert ActiveCell.Value = txt1 & Right(ActiveCell.Offset(1, 0).Value, Len(ActiveCell.Offset(1, 0).Value) - xNum + 1) - 1 Next InsertCounter End If Next Ndx End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Mon, 4 Feb 2013 23:37:14 +0000, TimLeonard wrote:
ActiveCell.Value = txt1 & Right(ActiveCell.Offset(1,0).Value, Len(ActiveCell.Offset(1, 0).Value) - xNum + 1) - 1 When you do the subtraction operation in the above line, the result is an unformatted number for that portion of the string. If you need it to always be padded to three digits, you need it to return a string. e.g: ActiveCell.Value = txt1 & Format(Right(ActiveCell.Offset(1, 0).Value, _ Len(ActiveCell.Offset(1, 0).Value) - xNum + 1) - 1, "000") |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Mon, 4 Feb 2013 23:37:14 +0000, TimLeonard wrote:
Also how can I add the ability to verify the number sequence will start at LxxD159 & LxxM159 respectively, where xx ranges from 1 to 10 (this could get the value from another worksheet.) In your example, you show the sequence ending at those values, not starting. Please clarify. Also, I expect your sheet is more complex than what you show. But if all you want to do is add the missing rows, it would likely be much faster to add the missing rows at the bottom, and then sort the results. Exactly how that could best be done would depend on what your sheet really looks like. |
#4
|
|||
|
|||
First off thank you very much for the reply, I knew it was something simple but I just couldn't find it...
Quote:
The intended function... Ultimately the intent is to compare a database on two separate worksheets. One database is manually updated or modified and the other is exported from a field panel and only contains what is programmed in the panel. That’s why this script is adding the missing row values to the field database so that the two worksheets will match, then a comparison can be made between the worksheets and display the differences on a third worksheet. For the ability to verify the number sequence will start at LxxD159 & LxxM159 respectively, where xx ranges from 1 to 10.... The panel supports the capacity of 159 D's and 159 M's on up to 10 different loops. The manually updated worksheet already has the values ranging from 1 to 159. Therefore I was looking for a way to verify in the panel worksheet the quantity of loops and then add the missing values starting at 159 and moving backwards through the columns so the worksheet rows will match for the comparison. BTW, the quantity of loops can coms from a column on the panel worksheet I hope this is understandable... Last edited by TimLeonard : February 5th 13 at 10:56 PM Reason: add info |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Tue, 5 Feb 2013 17:55:33 +0000, TimLeonard wrote:
First off thank you very much for the reply, I knew it was something simple but I just couldn't find it... Glad to help. Thanks for the feedback. In your example, you show the sequence ending at those values, not starting. Please clarify. I was referring to how the script functions...It starts at the bottom of the column and looks for the missing values and then adds it. OK The intended function... Ultimately the intent is to compare a database on two separate worksheets. One database is manually updated or modified and the other is exported from a field panel and only contains what is programmed in the panel. That’s why this script is adding the missing row values to the field database so that the two worksheets will match, then a comparison can be made between the worksheets and display the differences on a third worksheet. For the ability to verify the number sequence will start at LxxD159 & LxxM159 respectively, where xx ranges from 1 to 10.... The panel supports the capacity of 159 D's and 159 M's on up to 10 different loops. The manually updated worksheet already has the values ranging from 1 to 159. Therefore I was looking for a way to verify in the panel worksheet the quantity of loops and then add the missing values starting at 159 and moving backwards through the columns so the worksheet rows will match for the comparison. BTW, the quantity of loops can coms from a column on the panel worksheet I hope this is understandable... I think you might be making things needlessly complex. If you are looking for the differences between the two sheets, there are probably simpler ways to do the comparison, depending on how you want the differences reported. |
#6
|
|||
|
|||
Quote:
I have made worksheets "Summary" and "CompareDate" to reflect the end results which will then display the difference on the "Diff" sheet... Note that the "Summary" sheet is manually updated based on when device addresses is added to a drawing and the "comparedata" is when the device addresses is programmed in the field panel... Remember I am trying to make script to add the missing number sequence so the sample sheet "Orig Panel Data" would look like the "CompareDate" sheet to make the comparision work... I am open to suggestions as to wasys to make this simpler and or faster Thanks again |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Thu, 7 Feb 2013 04:29:27 +0000, TimLeonard wrote:
I am open to suggestions as to wasys to make this simpler and or faster A few questions after reviewing and some preliminaries: 1. If I remove lines that do not have any entry for "Device Types" form the Summary and CompareData sheets, will the result be those sheets without the extra rows? 2. Do you need to compare every cell in every row? If so, how do you account for the fact that Summary has 15 columns and CompareData only has 14 columns (missing column A). |
#8
|
|||
|
|||
Quote:
The purpose of the added rows on the "Summary" sheet is to represent the max devices per loop that the panel can use. This way the engineer will know what is available and what has been used in various drawings against what has been already been programmed in the field. so removing the empty fields would defeat the purpose... Quote:
Quote:
As an additional point, after a job is complete the database would be imported and at that point cells in colums "E-H" and possibly "I" should be populated on both "Summary " and "CompareData" sheets. Because the fieldpanel labels might be programmed differently than the engineering labels, so if if both sheets have populated rows in column "H" then the field labels should overwrite the engineering labels and then remove the info in "Summary" sheet column A Last edited by TimLeonard : February 8th 13 at 04:03 PM Reason: . |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Fri, 8 Feb 2013 07:28:06 +0000, TimLeonard wrote:
Yes it would be the same as the "Orig Panel Data" sheet... The purpose of the added rows on the "Summary" sheet is to represent the max devices per loop that the panel can use. This way the engineer will know what is available and what has been used in various drawings against what has been already been programmed in the field. so removing the empty fields would defeat the purpose... OK, that tells me that the extra rows have a different purpose than what I had assumed. This plus looking at the worksheets and code provokes a few more questions. Which column on "Orig Panel Data" tells how many "loops"? I would have assumed it to be the highest number in LoopSelection, but maybe not. Also, how are you constructing "Merged Address". I'm not seeing the code that does that, and that column does not exist on "Orig Panel Data" My plan was to start with "Orig Panel Data"; create an array with all of the required "Merged Address" entries, and then check to see which are missing. Once we know which are missing, they can be added at the bottom, and then the entire sheet sorted by Merged Address. However, that column is not present on "Orig Panel Data", and I don't see how to create it. By the way, I would assume, from what you've posted that the range of acceptable values for Merged Address is: Part 1 Part 2 Part 3 L01 - L10 D or M 001 - 159 e.g. L01D001 to L10M159 The only consistency I see is that if LoopSelection=1, then Part 2 = "D" if LoopSelection=2, then Part 2 = "M" |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Fri, 8 Feb 2013 07:28:06 +0000, TimLeonard wrote:
Yes it would be the same as the "Orig Panel Data" sheet... The purpose of the added rows on the "Summary" sheet is to represent the max devices per loop that the panel can use. This way the engineer will know what is available and what has been used in various drawings against what has been already been programmed in the field. so removing the empty fields would defeat the purpose... OK, I've done some work, but it is incomplete, awaiting your answers to my previous post. The way I would generate a worksheet that has all the possible "merged address" rows, would go something like: Start with an "Original Panel Data" that somehow includes the corresponding "Merged Address" fields. This is a problem as the Original Panel Data sheet I have does not have any Merged Addresses; for testing I generated something from your CompareData worksheet by removing all the rows that had a blank "Device Types" field. Ensure there are no duplicates (there shouldn't be, if I understand things, but check to be sure -- use range.removeduplicates method for all columns) Produce an array which includes all possible "merged addresses" given the number of loops ================ Function GenLoops(NumLoops) As Variant 'Part 1: L01-L10 'Part 2: D or M 'Part 3: 001-159 Dim MergAddr() As String Dim i As Long, j As Long, k As Long, m As Long ReDim MergAddr(1 To NumLoops * 2 * 159) For i = 1 To NumLoops For j = 1 To 2 For k = 1 To 159 m = m + 1 MergAddr(m) = "L" & Format(i, "00") & _ IIf(j = 1, "D", "M") & _ Format(k, "000") Next k Next j Next i GenLoops = MergAddr End Function ====================== Read Original Panel Data into a variant array e.g. vOrig = worksheet("Orig Panel Data").usedrange Create a collection object consisting of the used "merged addresses" Try to add to this collection from the inclusive list of all possible merged addresses. If the attempt to add does not produce an error, then we have identified a missing address and this should go into a collection of missing addresses. Read the collection into a 2D array so we can write it back to the worksheet expeditiously. Write vOrig to the top of the new (Compare or Summary) worksheet Write vNewAddresses onto the worksheet below this. Sort by Merged Address This method seems more complex to code than iterating through the worksheet, row by row, and testing each row, but by doing everything within VBA, using the collection object, and reading/writing to/from VBA/worksheet using the variant array methodology only at the beginning/end of the routine, it should execute considerably faster, especially with larger databases. Once we get this part working OK, we can go on to the comparison issue. |
#11
|
|||
|
|||
Quote:
Quote:
Quote:
e.g. Loop 1 = L01D001 to L01D159 & L01M001 to L01M159 up to Loop 10 = L10D001 to L10D159 & L10M001 to L10M159 Last edited by TimLeonard : February 10th 13 at 01:11 AM Reason: Added Info. |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Sun, 10 Feb 2013 00:20:45 +0000, TimLeonard wrote:
Response 1: By the way, I would assume, from what you've posted that the range of acceptable values for Merged Address is: Part 1 Part 2 Part 3 L01 - L10 D or M 001 - 159 e.g. L01D001 to L10M159 Actually each loop has 159 "D";s and 159 "M"'s e.g. Loop 1 = L01D001 to L01D159 & L01M001 to L01M159 up to Loop 10 = L10D001 to L10D159 & L10M001 to L10M159 I did mean to imply that the range would include "D" and "M" for each loop. Sorry if I was not clear |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Sun, 10 Feb 2013 00:20:45 +0000, TimLeonard wrote:
Response 2: Also, how are you constructing "Merged Address". I'm not seeing the code that does that, and that column does not exist on "PanelData" See the attached workbook module 2, but I like the code you posted... If you wanted to add a column to the "Paneldata" worksheet after column "F" then it could look at Col. "D" for the Loop, Col. "F" for the D or M (1=Device and 2=Module 3=Zone) and col. "E" for the address so the three columns would makeup the L01D001 Then I suppose it could be used in the array Looking at the latest workbook; worksheet PanelData, I am not understanding your explanation of how to construct MergedAddress. Previously you specified that the format of the merged address should be in the format of LaaXnnn where aa would be two digits in the range of 1-10 (eg 01-10) X could be D or M and nnn would be three digits in the range of 1-159 (eg 001-159) Previously you wrote that the loops go from L01... to L10..., but column D (LoopSelection) has values of 0, 1, 2. What to do if the value in column D is zero? Previously you wrote that what I am calling "X" (or "Part 2" in an earlier post) could be a D or M, but if I am looking at column F, I see values of 1, 2, 3 and 5. What to do if the value is not 1 or 2? Previously you wrote that what I am calling nnn above (or "Part 3" in an earlier post) would be in the range of 1-159, but if I am looking at Col "E", I see some values of zero (0). What to do if the value is zero? Also in this latest workbook, on the CompareData (or Summary) worksheets, you show Merged addresses which have formats that do not comply with your original specifications! Here are some: L00000 L00001 L00002 L00003 L00004 L00005 L00006 L00007 L00008 L00009 L00Z000 L00Z001 Either the specifications are incomplete, or there is a problem with the data in this latest workbook. I've got the basics of the code set up, but I need better specifications to proceed. -- Ron |
#14
|
|||||
|
|||||
Quote:
Quote:
Quote:
.Range("E2").Formula = "=IF(D2=3,""Zone"",IF(D2=2,""Monitor"",IF(D2=1,""D etector"","""")))" This was the only way I knew to get the "D" or "M" and while the "5" isn't used in this I left it in the comparison... Additionally the current values of 1, 2, 3 and 5 are what is used now but this area could expand or change completely in the future and I would need the ability to modify the code to work.... Quote:
Quote:
L01D159 L01M005 L01M006 Also, if a new loop was added, it doesn't check the "Summary" sheet to see if it needs to be added there as well, nor does it write any data changes from to "CompareData" sheet to the "Summary" sheet such as if the programmed labels were different on the sheets and remove the column "A" project number info... Perhaps one disconnect is that I made all comments using the "Summary" and "CompareData" sheets, which copies columns from the "PanelData sheets and sorts the data and adds the above mentioned code for adding the missing numbers, and I think now we are discussing using the "PanelData" sheet for that info instead... I do want to Thank You for time and efforts, I truley appreciate |
#15
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Sun, 10 Feb 2013 19:43:27 +0000, TimLeonard wrote:
I feel I am not communicating. Previously you specified that the format of the merged address should be in the format of LaaXnnn where aa would be two digits in the range of 1-10 (eg 01-10) X could be D or M and nnn would be three digits in the range of 1-159 (eg 001-159) This is still the correct format...and the way it would be assigned to a device on the drawings... Previously you wrote that the loops go from L01... to L10..., but column D (LoopSelection) has values of 0, 1, 2. What to do if the value in column D is zero? In the loopselection column of the "paneldata" worksheet the zero is for zones and can go up to the value of 10 depending on how many loop are installed in the field panel. But you wrote that I should "Look at Column D for the loop". If the loops MUST be in the range of one to ten (L01 - L10), what do you want to happen if the value in column D is zero?? Previously you wrote that what I am calling "X" (or "Part 2" in an earlier post) could be a D or M, but if I am looking at column F, I see values of 1, 2, 3 and 5. What to do if the value is not 1 or 2? On the "CompareData" worksheet the code from module 1 took the values and made them either Devices or Modules, using the following Range("E2").Formula = "=IF(D2=3,""Zone"",IF(D2=2,""Monitor"",IF(D2=1,"" Detector"","""")))" This was the only way I knew to get the "D" or "M" and while the "5" isn't used in this I left it in the comparison... Additionally the current values of 1, 2, 3 and 5 are what is used now but this area could expand or change completely in the future and I would need the ability to modify the code to work.... The question I am asking has to do with constructing the MERGED ADDRESS, which is supposed to be a D or an M. Your formula above is being used for a different purpose, and does not result in a D or M. You wrote: Col. "F" for the D or M (1=Device and 2=Module 3=Zone), but since we are restricted to only D or M, I need to know what to do if the contents of Col F is not a one or a two. (So far as populating column E in the CompareData sheet, we'll deal with that after I understand how to construct the Merged Address -- it will be simple in code and simple to maintain or expand). Previously you wrote that what I am calling nnn above (or "Part 3" in an earlier post) would be in the range of 1-159, but if I am looking at Col "E", I see some values of zero (0). What to do if the value is zero? The range 1-159 represent the programmable device address range...and the zero or zone numbers represent the panels logic...So at this point zeros or zones has been kept in the mix for the comparison. However in my code Module 2 merges the columns it put "L00" on them, which was the best I could do... They should read either Zone 1-999 or Blank for 00-10 but this was too complicated for me to isolate so I left it alone...This resulted in the L00000-L00009 and the L00Z000-L00Z999 you see in the "Summary" and the CompareData" worksheets... I'm sure the code I have can deal with what you want to do, but I don't understand what you want to do with regard to constructing a merged address with the specifications of that value being in the range of L01D001 to L10M159. Please try to be specific. It doesn't matter what the 1-159 represents in terms of the programming. No matter what they represent, they will be the terminal three digits of "Merged Address". What matters is what you want to happen if the value in that column is outside of the range 1-159. In other words, what should happen to the Merged Address if the value in that column is zero? Any number of things are possible, including constructing a Merged Address that does not conform to the specifications above, or even excluding that line from CompareData completely.. But if you want to include the line, you will need to decide what should be in the "Merged Address" column. Either the specifications are incomplete, or there is a problem with the data in this latest workbook. I've got the basics of the code set up, but I need better specifications to proceed. At this point I think the second workbook, as slow as it is and from piecing various codes together, works through all we have discussed except when adding missing addresses... But in some cases, it does not complete to address 001 but would stop at address 005. This causes the "Diff" worksheet to be populated with more cell differences than it should...For example... L01D159 L01M005 L01M006 Also, if a new loop was added, it doesn't check the "Summary" sheet to see if it needs to be added there as well, nor does it write any data changes from to "CompareData" sheet to the "Summary" sheet such as if the programmed labels were different on the sheets and remove the column "A" project number info... Perhaps one disconnect is that I made all comments using the "Summary" and "CompareData" sheets, which copies columns from the "PanelData sheets and sorts the data and adds the above mentioned code for adding the missing numbers, and I think now we are discussing using the "PanelData" sheet for that info instead... I was under the impression that PanelData represented the original data, and was derived from some source probably not under your control. It will be far simpler to start at that point; construct the MergedAddresses according to a well defined algorithm; and then construct the CompareData and Summary sheets appropriately. Once this is done, it will be relatively simple to determine the cell differences. |
#16
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Sun, 10 Feb 2013 19:43:27 +0000, TimLeonard wrote:
At this point I think the second workbook, as slow as it is and from piecing various codes together, works through all we have discussed except when adding missing addresses... But in some cases, it does not complete to address 001 but would stop at address 005. The following code starts with Worksheet "PanelData" as presented in your most recent workbook, and constructs a CompareData worksheet which, in order to not conflict, I have named "CompareData2". I am trying to see if I am on the right track. This macro runs (on my machine), in less than one second. It adds in all of the missing merged addresses. It presents the columns in the same order that you have on your CompareData sheet. It does NOT include lines that do not compute to a valid Merged Address code. (That can be changed if you like, but you'll need to define how to handle them). It does NOT fill in the Node Address, LoopSelection, DeviceAddress fields at this time, but that can be easily changed if I am on the right track. What do you think? ============================================= Option Explicit Sub CreateCompareDataSheet() 'Do this on a CompareData2 Sheet 'Keep only columns C:H 'Remove lines with no valid Device Address; (or not as required) 'Add Merged Address Column 'Append the "missing" Merged Addresses 'Rearrange columns by horizontal sorting according to custom list 'Sort results by Merged Address Dim wsCompareData2 As Worksheet Dim wsPD As Worksheet, vPD As Variant 'Panel Data Dim r As Range Dim LScol As Long 'Loop Selection column Dim DTPcol As Long 'Device Type column Dim sDTP As String Dim DAcol As Long 'Device Address column Dim MAcol As Long 'Merged Address column Dim collUsedMA As Collection 'Used Merged Address Collection Dim collMissMA As Collection 'Missing Merged Addresses Dim DTPScol As Long 'Device Types column Dim aTemp() As Variant Dim v As Variant Dim i As Long, j As Long Set wsPD = Worksheets("PanelData") 'Clear CompareData2 sheet if present; create if not On Error Resume Next Set wsCompareData2 = Worksheets("CompareData2") If Err.Number = 9 Then Worksheets.Add ActiveSheet.Name = "CompareData2" Set wsCompareData2 = Worksheets("CompareData2") End If On Error GoTo 0 wsCompareData2.Cells.Clear 'Read Panel Data into array 'Assuming zero(0) blanks in Col A 'Assume we will retain only cols A:H With wsPD vPD = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) _ .Offset(columnoffset:=2).Resize(columnsize:=6) End With 'Add column for merged address 'For now, it will be the "last column", but could be moved if desired ReDim Preserve vPD(1 To UBound(vPD, 1), 1 To UBound(vPD, 2) + 2) MAcol = UBound(vPD, 2) - 1 DTPScol = UBound(vPD, 2) vPD(1, MAcol) = "Merged Address" vPD(1, DTPScol) = "Device Types" 'Get column numbers for data to create MergedAddress ReDim aTemp(1 To UBound(vPD, 2)) For i = 1 To UBound(vPD, 2) aTemp(i) = vPD(1, i) Next i With WorksheetFunction LScol = .Match("LoopSelection", aTemp, 0) DTPcol = .Match("DeviceType", aTemp, 0) DAcol = .Match("DeviceAddress", aTemp, 0) End With 'Create Merged Addresses 'Add Device Types Field Set collUsedMA = New Collection For i = 2 To UBound(vPD, 1) Select Case vPD(i, DTPcol) Case Is = 1 sDTP = "D" vPD(i, DTPScol) = "Detector" Case Is = 2 sDTP = "M" vPD(i, DTPScol) = "Monitor" Case Is = 3 sDTP = "" vPD(i, DTPScol) = "Zone" Case Else sDTP = "" End Select If Not sDTP = "" Then vPD(i, MAcol) = "L" & Format(vPD(i, LScol), "00") & _ sDTP & _ Format(vPD(i, DAcol), "000") On Error Resume Next collUsedMA.Add Item:=vPD(i, MAcol), Key:=vPD(i, MAcol) If Err.Number < 0 Then MsgBox ("Merged Address: " & vPD(i, MAcol) & _ "on Line " & i & " is a duplicate") Exit Sub End If On Error GoTo 0 End If Next i 'Develop collection of Missing Merged Addresses Set collMissMA = New Collection With WorksheetFunction LScol = .Match("LoopSelection", wsPD.Rows(1), 0) v = GenLoops(.Max(wsPD.Columns(LScol))) End With On Error Resume Next For i = LBound(v) To UBound(v) collUsedMA.Add Item:=v(i), Key:=v(i) If Err.Number = 0 Then collMissMA.Add Item:=v(i), Key:=v(i) End If Err.Clear Next i 'write array to CompareData2 sheet 'sort by Merged Addresses and delete lines with no MA's 'then sort horizontally by first row and custom sort 'set up custom order based on fields in row 1 of panel data 'verify labels are correct 'Column Headers for Compare and Summary Sheets 'Need to be in the desired order -- will be used as a Custom Sort Order List 'Need to match exactly the headers (but not the order) ' on the PanelData worksheet Dim aCL(1 To 8) 'custom list array aCL(1) = "NodeAddress" aCL(2) = "LoopSelection" aCL(3) = "DeviceAddress" aCL(4) = "Merged Address" aCL(5) = "DeviceType" aCL(6) = "Device Types" aCL(7) = "DeviceLabel" aCL(8) = "ExtendedLabel" ReDim aTemp(1 To UBound(vPD, 2)) For i = 1 To UBound(vPD, 2) aTemp(i) = vPD(1, i) Next i On Error Resume Next For i = 1 To UBound(aCL) j = WorksheetFunction.Match(aCL(i), aTemp, 0) If Err.Number < 0 Then MsgBox (aCL(i) & " Not exact match in Panel Data Label row") Exit Sub End If Next i 'Write data to CompareData2 sheet Application.ScreenUpdating = False With wsCompareData2 Set r = .Range("B1", .Cells(UBound(vPD, 1), UBound(vPD, 2) + 1)) r = vPD 'Add the Missing Merged Addresses to the correct column ReDim aTemp(1 To collMissMA.Count, 1 To 1) For i = 1 To collMissMA.Count aTemp(i, 1) = collMissMA(i) Next i MAcol = WorksheetFunction.Match("Merged Address", .Rows(1), 0) Set r = .Range(Cells(r.Row + r.Rows.Count, MAcol), _ Cells(r.Rows.Count + UBound(aTemp, 1), MAcol)) r = aTemp 'Sort by Merged Address and delete those with blank MA's .Sort.SortFields.Clear .Sort.SortFields.Add Key:=Range(.Cells(.UsedRange.Row + 1, MAcol), _ .Cells(.UsedRange.Row + .UsedRange.Rows.Count, MAcol)), _ SortOn:=xlsortonxlvalues, Order:=xlAscending With .Sort .SetRange wsCompareData2.UsedRange .Header = xlYes .Orientation = xlTopToBottom .Apply End With Set r = .Cells(.Cells.Rows.Count, MAcol).End(xlUp).Offset(1) Set r = Range(r, r.End(xlDown)) r.EntireRow.Delete 'Now sort horizontally to reorder the columns .Sort.SortFields.Clear .Sort.SortFields.Add Key:=Range("B1", .Cells(1, .Columns.Count).End(xlToLeft)), _ SortOn:=xlSortOnValues, Order:=xlAscending, _ CustomOrder:=Join(aCL, ",") With .Sort .SetRange wsCompareData2.UsedRange .Header = xlYes .Orientation = xlLeftToRight .Apply End With ..UsedRange.EntireColumn.AutoFit End With Application.ScreenUpdating = True End Sub '------------------------------------------------------- Function GenLoops(NumLoops) As Variant 'Part 1: L01-L10 'Part 2: D or M 'Part 3: 001-159 Dim MergAddr() As String Dim i As Long, j As Long, k As Long, m As Long ReDim MergAddr(1 To NumLoops * 2 * 159) For i = 1 To NumLoops For j = 1 To 2 For k = 1 To 159 m = m + 1 MergAddr(m) = "L" & Format(i, "00") & _ IIf(j = 1, "D", "M") & _ Format(k, "000") Next k Next j Next i GenLoops = MergAddr End Function =========================================== |
#17
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Sun, 10 Feb 2013 19:43:27 +0000, TimLeonard wrote:
At this point I think the second workbook, as slow as it is and from piecing various codes together, works through all we have discussed except when adding missing addresses.. Here is a modified version that includes: Filling in the Loop Selection, Device Address and Device Type entries for the "missing" Merged Address Entries Formats the first row to have the gray interior and frozen header row as you do in some of your other examples. Includes some "clean-up" with regard to references. I could not fill in the NodeAddress column as I do not know how these are derived from the information I have. It runs in less than 1/2 second on my machine. It will not run as written on versions of Excel prior to 2007. If you might be running this on a Macintosh, you will need to change the interior color format to something that does not involve RGB. ================================ Option Explicit Sub CreateCompareDataSheet() 'Do this on a CompareData2 Sheet 'Keep only columns C:H 'Remove lines with no valid Device Address; (or not as required) 'Add Merged Address Column 'Append the "missing" Merged Addresses 'Rearrange columns by horizontal sorting according to custom list 'Sort results by Merged Address Dim wsCompareData2 As Worksheet Dim wsPD As Worksheet, vPD As Variant 'Panel Data Dim r As Range, rw As Range, rMissed As Range Dim LScol As Long 'Loop Selection column Dim DTPcol As Long 'Device Type column Dim sDTP As String Dim DAcol As Long 'Device Address column Dim MAcol As Long 'Merged Address column Dim collUsedMA As Collection 'Used Merged Address Collection Dim collMissMA As Collection 'Missing Merged Addresses Dim DTPScol As Long 'Device Types column Dim aTemp() As Variant Dim v As Variant Dim i As Long, j As Long Set wsPD = Worksheets("PanelData") 'Clear CompareData2 sheet if present; create if not On Error Resume Next Set wsCompareData2 = Worksheets("CompareData2") If Err.Number = 9 Then Worksheets.Add ActiveSheet.Name = "CompareData2" Set wsCompareData2 = Worksheets("CompareData2") End If On Error GoTo 0 wsCompareData2.Cells.Clear 'Read Panel Data into array 'Assuming zero(0) blanks in Col A 'Assume we will retain only cols A:H With wsPD vPD = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) _ .Offset(columnoffset:=2).Resize(columnsize:=6) End With 'Add column for merged address 'For now, it will be the "last column", but could be moved if desired ReDim Preserve vPD(1 To UBound(vPD, 1), 1 To UBound(vPD, 2) + 2) MAcol = UBound(vPD, 2) - 1 DTPScol = UBound(vPD, 2) vPD(1, MAcol) = "Merged Address" vPD(1, DTPScol) = "Device Types" 'Get column numbers for data to create MergedAddress ReDim aTemp(1 To UBound(vPD, 2)) For i = 1 To UBound(vPD, 2) aTemp(i) = vPD(1, i) Next i With WorksheetFunction LScol = .Match("LoopSelection", aTemp, 0) DTPcol = .Match("DeviceType", aTemp, 0) DAcol = .Match("DeviceAddress", aTemp, 0) End With 'Create Merged Addresses 'Add Device Types Field Set collUsedMA = New Collection For i = 2 To UBound(vPD, 1) Select Case vPD(i, DTPcol) Case Is = 1 sDTP = "D" vPD(i, DTPScol) = "Detector" Case Is = 2 sDTP = "M" vPD(i, DTPScol) = "Monitor" Case Is = 3 sDTP = "" vPD(i, DTPScol) = "Zone" Case Else sDTP = "" End Select If Not sDTP = "" Then vPD(i, MAcol) = "L" & Format(vPD(i, LScol), "00") & _ sDTP & _ Format(vPD(i, DAcol), "000") On Error Resume Next collUsedMA.Add Item:=vPD(i, MAcol), Key:=vPD(i, MAcol) If Err.Number < 0 Then MsgBox ("Merged Address: " & vPD(i, MAcol) & _ "on Line " & i & " is a duplicate") Exit Sub End If On Error GoTo 0 End If Next i 'Develop collection of Missing Merged Addresses Set collMissMA = New Collection With WorksheetFunction LScol = .Match("LoopSelection", wsPD.Rows(1), 0) v = GenLoops(.Max(wsPD.Columns(LScol))) End With On Error Resume Next For i = LBound(v) To UBound(v) collUsedMA.Add Item:=v(i), Key:=v(i) If Err.Number = 0 Then collMissMA.Add Item:=v(i), Key:=v(i) End If Err.Clear Next i 'write array to CompareData2 sheet 'sort by Merged Addresses and delete lines with no MA's 'then sort horizontally by first row and custom sort 'set up custom order based on fields in row 1 of panel data 'verify labels are correct 'Column Headers for Compare and Summary Sheets 'Need to be in the desired order -- will be used as a Custom Sort Order List 'Need to match exactly the headers (but not the order) ' on the PanelData worksheet Dim aCL(1 To 8) 'custom list array aCL(1) = "NodeAddress" aCL(2) = "LoopSelection" aCL(3) = "DeviceAddress" aCL(4) = "Merged Address" aCL(5) = "DeviceType" aCL(6) = "Device Types" aCL(7) = "DeviceLabel" aCL(8) = "ExtendedLabel" ReDim aTemp(1 To UBound(vPD, 2)) For i = 1 To UBound(vPD, 2) aTemp(i) = vPD(1, i) Next i On Error Resume Next For i = 1 To UBound(aCL) j = WorksheetFunction.Match(aCL(i), aTemp, 0) If Err.Number < 0 Then MsgBox (aCL(i) & " Not exact match in Panel Data Label row") Exit Sub End If Next i 'Write data to CompareData2 sheet Application.ScreenUpdating = False With wsCompareData2 Set r = .Range("B1").Resize(rowsize:=UBound(vPD, 1), columnsize:=UBound(vPD, 2)) r = vPD 'Add the Missing Merged Addresses to the correct column 'Also deconstruct to fill in the LS, DA and DT columns Set rw = r.Rows(1) With WorksheetFunction MAcol = .Match("Merged Address", rw, 0) LScol = .Match("LoopSelection", rw, 0) DAcol = .Match("DeviceAddress", rw, 0) DTPcol = .Match("DeviceType", rw, 0) End With ReDim aTemp(1 To collMissMA.Count, 1 To r.Columns.Count) For i = 1 To collMissMA.Count aTemp(i, MAcol) = collMissMA(i) aTemp(i, LScol) = Val(Mid(collMissMA(i), 2, 2)) aTemp(i, DAcol) = Val(Right(collMissMA(i), 3)) aTemp(i, DTPcol) = IIf(Mid(collMissMA(i), 4, 1) = "D", 1, 2) Next i Set rMissed = .Cells(r.Row + r.Rows.Count, r.Column).Resize(rowsize:=UBound(aTemp, 1), columnsize:=UBound(aTemp, 2)) rMissed = aTemp Set r = Union(r, rMissed) 'Sort by Merged Address and delete those with blank MA's .Sort.SortFields.Clear .Sort.SortFields.Add Key:=r.Resize(rowsize:=r.Rows.Count - 1).Offset(rowoffset:=1).Columns(MAcol), _ SortOn:=xlSortOnValues, Order:=xlAscending With .Sort .SetRange r .Header = xlYes .Orientation = xlTopToBottom .Apply End With Set r = Range(r(1, MAcol).End(xlDown).Offset(rowoffset:=1), r(.Cells.Rows.Count, MAcol)) r.EntireRow.Delete 'Now sort horizontally to reorder the columns Set r = .UsedRange .Sort.SortFields.Clear .Sort.SortFields.Add Key:=r.Rows(1), _ SortOn:=xlSortOnValues, Order:=xlAscending, _ CustomOrder:=Join(aCL, ",") With .Sort .SetRange r .Header = xlYes .Orientation = xlLeftToRight .Apply End With r.EntireColumn.AutoFit 'NOTE: Cannot use RGB on Macintosh. If that is a problem, use something 'like colorindex 15 r.Rows(1).Interior.Color = RGB(191, 191, 191) 'Same gray as on your Summary Sheet 'I don't like to activate or select, but I don't know how else to ' freeze panes .Activate With ActiveWindow .SplitRow = 1 .FreezePanes = True End With End With Application.ScreenUpdating = True End Sub '------------------------------------------------------- Function GenLoops(NumLoops) As Variant 'Part 1: L01-L10 'Part 2: D or M 'Part 3: 001-159 Dim MergAddr() As String Dim i As Long, j As Long, k As Long, m As Long ReDim MergAddr(1 To NumLoops * 2 * 159) For i = 1 To NumLoops For j = 1 To 2 For k = 1 To 159 m = m + 1 MergAddr(m) = "L" & Format(i, "00") & _ IIf(j = 1, "D", "M") & _ Format(k, "000") Next k Next j Next i GenLoops = MergAddr End Function ================================== |
#18
|
|||
|
|||
Quote:
I will also reply here instead of the previous posts to keep it current... My initial thought was always around the device/module addresses, but after giving this more thought, If it’s not too much to include, I think it should also populate the zones, these have the device type value of (3) and the loopselection of (0) they should be in the format of Z000-Z999…The device type values of (5) can be excluded Question… Is there a way to have it look at the “summary” sheet to see if the Node Address, LoopSelection, DeviceAddress and Merged Address fields need to be updated…I know I told you this is manually populated but my thought is that if an additional loop was added in the field panel not exceeding ten loops, rather than having to manually insert the additional rows, have the code do it? Another concern I have is what if the technician re-labels a device/module or zone, how can we update the summary sheet with the revised labels. Originally I planned to have code look at both sheets labels and if they were both greater than blank then overwrite the data on the summary sheet in the same row/cells. There is one piece that was too complicated for me, that may prove easy for you…On the “PanelData”column “K” there is values that correlate to another worksheet that is imported named “DeviceType”. On that Sheet “DeviceType” in Column “A” it has those same values and in Column ”E” has the Device Type Labels that if possible, I would like to included on Both the “Summary” and “CompareData2” Worksheets Column “J” (once they both match column wise) Quote:
This will be use on Excel 2007 and not on a Macintosh BTW I was going to tell you that there was a small issue, if on another tab when the macro is ran the results are not what is expected… But you seemed to have fixed it on the revised code… Last edited by TimLeonard : February 12th 13 at 03:21 AM Reason: Added Comment |
#19
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
Questions in line below Incredible!!! You are on the right track… I will also reply here instead of the previous posts to keep it current... My initial thought was always around the device/module addresses, but after giving this more thought, If it’s not too much to include, I think it should also populate the zones, these have the device type value of (3) and the loopselection of (0) they should be in the format of Z000-Z999…The device type values of (5) can be excluded Just to be clear If Device Type = 3 Merged Address = Znnn where nnn is the Device Address with three digits and you also want to have blank entries for the missing values in the range of 000-999 (So it would not be L00Z000 - L00Z999 but just Z000-Z999) Question… Is there a way to have it look at the “summary” sheet to see if the Node Address, LoopSelection, DeviceAddress and Merged Address fields need to be updated…I know I told you this is manually populated but my thought is that if an additional loop was added in the field panel not exceeding ten loops, rather than having to manually insert the additional rows, have the code do it? As designed, the code I have provided generates a CompareData sheet (named CompareData2) using the sheet PanelData. I have not got to the Summary sheet yet. Is the entire summary sheet manually generated? If so, how do you mitigate for data entry errors? If not, how is it generated. Another concern I have is what if the technician re-labels a device/module or zone, how can we update the summary sheet with the revised labels. What process does the technician go thru in order to do this. Originally I planned to have code look at both sheets labels what do you mean by "both sheets labels"? and if they were both greater than blank then overwrite the data on the summary sheet in the same row/cells. This specification needs clarification. --------------------------------------- There is one piece that was too complicated for me, that may prove easy for you…On the “PanelData”column “K” there is values that correlate to another worksheet that is imported named “DeviceType”. On that Sheet “DeviceType” in Column “A” it has those same values and in Column ”E” has the Device Type Labels that if possible, I would like to included on Both the “Summary” and “CompareData2” Worksheets Column “J” (once they both match column wise) I don't know what you are trying to specify here. Column K on PanelData is marked, on my copy, TypeID with a notation it is to be removed to reduce file size. There is no data there. But any column from PanelData can be included on CompareData. You just enlarge the vPD array to accomodate it. If you are adding data from other worksheets, you are going to need to be sure it matches up with the devices/zones that are already there. I could not fill in the NodeAddress column as I do not know how these are derived from the information I have. Since the panel will max out with the (10) loop the node address will be 1 throughout the column.. I will modify the code to include the NodeAddress This will be use on Excel 2007 and not on a Macintosh BTW I was going to tell you that there was a small issue, if on another tab when the macro is ran the results are not what is expected… But you seemed to have fixed it on the revised code… +-------------------------------------------------------------------+ +-------------------------------------------------------------------+ |
#20
|
||||||
|
||||||
Quote:
Quote:
Quote:
But since the "PanelData" is what is programmed in the field panel and the “Summary” sheet is manually imputed, I am sure there will be times when the two worksheets will differ concerning the same rows/cells….Now here is where it gets tricky to explain…The “Summary” sheet in theory, should have all the programmed rows/cells populated the same as the “CompareData” sheet Plus it should also have the additional device address information that have been used on all the drawings not yet installed and programmed into the field panels. So I believe if it was to have something coded to verify if a loop was added or if label changes have been made in the field and then update the summary sheet with the changes it should only look at rows/cells that were populated on both worksheets and should not change / update any rows/cells that are only on the “Summary” Sheet that relate to the engineered devices that have not been installed or programmed in the field panel and does not match the “PanelData” sheet…. Quote:
In regards to the comment…[ Originally I planned to have code look at both sheets labels “if they were both greater than blank then overwrite the data on the summary sheet in the same row/cells.” ] I was referring to the “DeviceLabels” and the “Extended Labels” columns of to both sheets, the “Summary” and the “CompareData” worksheets…This would have been the only way I would have known to do it….I am sure there are better ways to update the labels so I am opening the door to suggestions Quote:
You said the following: “You just enlarge the vPD array to accomodate it. If you are adding data from other worksheets, you are going to need to be sure it matches up with the devices/zones that are already there.” …..I think it might be a little more complicated, “PanelData” Column K refers to a number the matches a number in the worksheet “DeviceType” column A and the label in column “E”.. To illustrate, sheet “PanelData” row 1020 column “K” has a value of 40, sheet “DeviceType” column “A” row 7 has the same value of 40 and column “E” has the label of “Smoke(Photo)”…This is what I would like to put on the sheet “CompareData2” row 1020 column “J” Quote:
Since the panel will max out with the (10) loop for the NodeAddress, it will be "1" for the first (10) loops then it will be "2" for the next (10) loops and so up to 104 NodeAddresses. However most "PanelData" sheets will only contain 1 NodeAddress Last edited by TimLeonard : February 12th 13 at 11:48 PM Reason: Added to comment |
#21
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Tue, 12 Feb 2013 22:11:55 +0000, TimLeonard wrote:
Sorry but I revised the statement and I don’t think you caught that… Since the panel will max out with the (10) loop for the NodeAddress, it will be "1" for the first (10) loops then it will be "2" for the next (10) loops and so up to 104 NodeAddresses. However most "PanelData" sheets will only contain 1 NodeAddress I will review the new workbooks and the rest of this response of yours. (BTW, for some reason this response of yours has a bunch of formatting codes like … I think they are HTML codes and don't know why this newsreader doesn't handle them). With regard to this comment above of yours, since we are not including any NodeAddress information in the Merged Address, there will be no accurate method of deriving it from the Merged Address; in addition, if there happens to be more than ten loops, there will be Identical Merged Addresses referring to different items. How do you want to deal with that issue? We could expand the Merged Addresses to something like AnnnLnn[DM]nnn where Annn is A001 to A104 Lnn is L01 to L10 [DM]nnn is D001 to D159 or M001 to M159 With regard to the Zones, if they could vary with the different NodeAddresses, a better format might be AnnnL00Znnn I have assumed that LoopSelection with the Zones will always be 0. Or perhaps you have another idea? |
#22
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
(BTW, for some reason this response of yours has a bunch of formatting codes
like … I think they are HTML codes and don't know why this newsreader doesn't handle them). I'm seeing the same junk. I suspect that at some point something got converted to plain text due to some setting somewhere in Tim's "Unknown" newsreader. -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#23
|
|||
|
|||
Strange but you reply did not post back to the forum...
Quote:
Typically when a drawing shows more than one Panel (Node Address) it is shown in the format of NxxLyyDzzz Perhaps it could be made to only include in the merged address the Nxx when the node address is greater than (1) otherwise it would be shown as LyyDzzz And you are correct to assume that the zones would always be shown ad zeros in the LoopSelection column |
#24
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Wed, 13 Feb 2013 23:11:06 +0000, TimLeonard wrote:
Wow you are so close in your thought process... Typically when a drawing shows more than one Panel (Node Address) it is shown in the format of NxxLyyDzzz You wrote that the NodeAddresses could have a maximum of 104. So how about a format of NxxxLyyDzzz ? Perhaps it could be made to only include in the merged address the Nxx when the node address is greater than (1) otherwise it would be shown as LyyDzzz OK, that is fairly simple and I've done that part, but with a format of NxxxLyyDzzz. We could vary the Nxxx portion to only show three digits if required, and two digits otherwise, but that will require some extra steps when it comes to sorting. And you are correct to assume that the zones would always be shown ad zeros in the LoopSelection column OK, but what about the NodeAddress for a Zone? And if that can vary, should we prepend Nxxx (or Nxx) to the Zxxx also? =========================== Here is the most recent iteration of the macro, including the above modifications to the MergedAddress routines, and with some rewriting to make future maintenance/modifications perhaps a bit simpler. ========================================== Option Explicit 'column names/labels are defined here. 'they must match exactly the names on PanelData Worksheet 'include names for any added columns ' and also be the same on any sheet generated ' by this code Public Const sNA As String = "NodeAddress" Public Const sLS As String = "LoopSelection" Public Const sDA As String = "DeviceAddress" Public Const sDT As String = "DeviceType" Public Const sDTS As String = "Device Types" Public Const sDL As String = "DeviceLabel" Public Const sEL As String = "ExtendedLabel" Public Const sMA As String = "Merged Address" Sub CreateCompareDataSheet() 'Do this on a CompareData2 Sheet 'Keep only columns C:H 'Remove lines with no valid Device Address; (or not as required) 'Add Merged Address Column 'Append the "missing" Merged Addresses 'Rearrange columns by horizontal sorting according to custom list 'Sort results by Merged Address Dim wsCompareData2 As Worksheet Dim wsPD As Worksheet, vPD As Variant 'Panel Data Dim r As Range, rw As Range, rMissed As Range Dim NAcol As Long 'NodeAddress column Dim LScol As Long 'Loop Selection column Dim DTcol As Long 'Device Type column Dim sDTP As String 'Used to create Merged Address Dim DAcol As Long 'Device Address column Dim MAcol As Long 'Merged Address column Dim collUsedMA As Collection 'Used Merged Address Collection Dim collMissMA As Collection 'Missing Merged Addresses Dim DTScol As Long 'Device Types column Dim aTemp() As Variant Dim v As Variant Dim i As Long, j As Long Set wsPD = Worksheets("PanelData") 'Clear CompareData2 sheet if present; create if not On Error Resume Next Set wsCompareData2 = Worksheets("CompareData2") If Err.Number = 9 Then Worksheets.Add ActiveSheet.Name = "CompareData2" Set wsCompareData2 = Worksheets("CompareData2") End If On Error GoTo 0 wsCompareData2.Cells.Clear 'Read Panel Data into array 'Assuming zero(0) blanks in Col A 'Assume we will retain only cols A:H With wsPD vPD = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) _ .Offset(columnoffset:=2).Resize(columnsize:=6) End With 'Add column for merged address 'For now, it will be the "last column", but could be moved if desired ReDim Preserve vPD(1 To UBound(vPD, 1), 1 To UBound(vPD, 2) + 2) MAcol = UBound(vPD, 2) - 1 DTScol = UBound(vPD, 2) vPD(1, MAcol) = sMA vPD(1, DTScol) = sDTS 'Get column numbers for data to create Used MergedAddress ReDim aTemp(1 To UBound(vPD, 2)) For i = 1 To UBound(vPD, 2) aTemp(i) = vPD(1, i) Next i With WorksheetFunction NAcol = .Match(sNA, aTemp, 0) LScol = .Match(sLS, aTemp, 0) DTcol = .Match(sDT, aTemp, 0) DAcol = .Match(sDA, aTemp, 0) End With 'Create Merged Addresses 'Add Device Types Field Set collUsedMA = New Collection For i = 2 To UBound(vPD, 1) Select Case vPD(i, DTcol) Case Is = 1 sDTP = "D" vPD(i, DTScol) = "Detector" Case Is = 2 sDTP = "M" vPD(i, DTScol) = "Monitor" Case Is = 3 sDTP = "Z" vPD(i, DTScol) = "Zone" Case Else sDTP = "" End Select If Not sDTP = "" Then vPD(i, MAcol) = _ IIf(vPD(i, NAcol) 1, "N" & Format(vPD(i, NAcol), "000"), "") & _ "L" & Format(vPD(i, LScol), "00") & _ sDTP & _ Format(vPD(i, DAcol), "000") 'Special Case for Z vPD(i, MAcol) = Replace(vPD(i, MAcol), "L00Z", "Z") On Error Resume Next collUsedMA.Add Item:=vPD(i, MAcol), Key:=vPD(i, MAcol) If Err.Number < 0 Then MsgBox ("Merged Address: " & vPD(i, MAcol) & _ "on Line " & i & " is a duplicate") Exit Sub End If On Error GoTo 0 End If Next i 'Develop collection of Missing Merged Addresses Set collMissMA = New Collection With WorksheetFunction NAcol = .Match(sNA, wsPD.Rows(1), 0) LScol = .Match(sLS, wsPD.Rows(1), 0) v = GenLoops(.Max(wsPD.Columns(LScol)), .Max(wsPD.Columns(NAcol))) End With On Error Resume Next For i = LBound(v) To UBound(v) collUsedMA.Add Item:=v(i), Key:=v(i) If Err.Number = 0 Then collMissMA.Add Item:=v(i), Key:=v(i) End If Err.Clear Next i 'write array to CompareData2 sheet 'sort by Merged Addresses and delete lines with no MA's 'then sort horizontally by first row and custom sort 'set up custom order based on fields in row 1 of panel data 'verify labels are correct 'Column Headers for Compare and Summary Sheets 'Need to be in the desired order -- will be used as a Custom Sort Order List 'Need to match exactly the headers (but not the order) ' on the PanelData worksheet Dim aCL(1 To 8) 'custom list array aCL(1) = sNA aCL(2) = sLS aCL(3) = sDA aCL(4) = sMA aCL(5) = sDT aCL(6) = sDTS aCL(7) = sDL aCL(8) = sEL ReDim aTemp(1 To UBound(vPD, 2)) For i = 1 To UBound(vPD, 2) aTemp(i) = vPD(1, i) Next i On Error Resume Next For i = 1 To UBound(aCL) j = WorksheetFunction.Match(aCL(i), aTemp, 0) If Err.Number < 0 Then MsgBox (aCL(i) & " Not exact match in Panel Data Label row") Exit Sub End If Next i 'Write data to CompareData2 sheet Application.ScreenUpdating = False With wsCompareData2 Set r = .Range("B1").Resize(rowsize:=UBound(vPD, 1), columnsize:=UBound(vPD, 2)) r = vPD 'Add the Missing Merged Addresses to the correct column 'Also deconstruct to fill in the NA, LS, DA and DT columns 'Possible formats ' Znnn ' LnnXnnn ' NnnnLnnXnnn Set rw = r.Rows(1) With WorksheetFunction MAcol = .Match(sMA, rw, 0) LScol = .Match(sLS, rw, 0) DAcol = .Match(sDA, rw, 0) DTcol = .Match(sDT, rw, 0) NAcol = .Match(sNA, rw, 0) End With ReDim aTemp(1 To collMissMA.Count, 1 To r.Columns.Count) For i = 1 To collMissMA.Count aTemp(i, MAcol) = collMissMA(i) aTemp(i, DAcol) = Val(Right(collMissMA(i), 3)) Select Case Left(collMissMA(i), 1) Case Is = "Z" aTemp(i, LScol) = 0 aTemp(i, DTcol) = 3 Case Is = "L" aTemp(i, NAcol) = 1 aTemp(i, LScol) = Val(Mid(collMissMA(i), 2, 2)) Select Case Mid(collMissMA(i), 4, 1) Case Is = "D" aTemp(i, DTcol) = 1 Case Is = "M" aTemp(i, DTcol) = 2 End Select Case Is = "N" aTemp(i, NAcol) = Val(Mid(collMissMA(i), 2, 3)) aTemp(i, LScol) = Val(Mid(collMissMA(i), 6, 2)) Select Case Mid(collMissMA(i), 8, 1) Case Is = "D" aTemp(i, DTcol) = 1 Case Is = "M" aTemp(i, DTcol) = 2 End Select End Select Next i Set rMissed = .Cells(r.Row + r.Rows.Count, r.Column).Resize(rowsize:=UBound(aTemp, 1), columnsize:=UBound(aTemp, 2)) rMissed = aTemp Set r = Union(r, rMissed) 'Sort by Merged Address and delete those with blank MA's 'if result of sort needs to have Zones last then will need to add a dummy column for sorting .Sort.SortFields.Clear .Sort.SortFields.Add Key:=r.Resize(rowsize:=r.Rows.Count - 1).Offset(rowoffset:=1).Columns(MAcol), _ SortOn:=xlSortOnValues, Order:=xlAscending With .Sort .SetRange r .Header = xlYes .Orientation = xlTopToBottom .Apply End With Set r = Range(r(1, MAcol).End(xlDown).Offset(rowoffset:=1), r(.Cells.Rows.Count, MAcol)) r.EntireRow.Delete 'Now sort horizontally to reorder the columns Set r = .UsedRange .Sort.SortFields.Clear .Sort.SortFields.Add Key:=r.Rows(1), _ SortOn:=xlSortOnValues, Order:=xlAscending, _ CustomOrder:=Join(aCL, ",") With .Sort .SetRange r .Header = xlYes .Orientation = xlLeftToRight .Apply End With r.EntireColumn.AutoFit 'NOTE: Cannot use RGB on Macintosh. If that is a problem, use something 'like colorindex 15 r.Rows(1).Interior.Color = RGB(191, 191, 191) 'Same gray as on your Summary Sheet 'I don't like to activate or select, but I don't know how else to ' freeze panes .Activate With ActiveWindow .SplitRow = 1 .FreezePanes = True End With .Range("a1").Select End With Application.ScreenUpdating = True End Sub '------------------------------------------------------- Function GenLoops(NumLoops As Long, NumNodes As Long) As Variant 'Part 0: N001-N104 (optional) 'Part 1: L01-L10 'Part 2: D or M 'Part 3: 001-159 Dim MergAddr() As String Dim i As Long, j As Long, k As Long, l As Long, m As Long ReDim MergAddr(1 To NumNodes * NumLoops * 2 * 159 + 1000) '+1000 for the zones For i = 1 To NumNodes For j = 1 To NumLoops For k = 1 To 2 For l = 1 To 159 m = m + 1 MergAddr(m) = _ IIf(i 1, "N" & Format(i, "000"), "") & _ "L" & Format(j, "00") & _ IIf(k = 1, "D", "M") & _ Format(l, "000") Next l Next k Next j Next i 'add in the Zones Merged Addresses j = NumNodes * NumLoops * 2 * 159 For i = 1 To 1000 MergAddr(i + j) = "Z" & Format(i - 1, "000") Next i GenLoops = MergAddr End Function ================================= |
#25
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Wed, 13 Feb 2013 17:04:21 -0500, GS wrote:
(BTW, for some reason this response of yours has a bunch of formatting codes like … I think they are HTML codes and don't know why this newsreader doesn't handle them). I'm seeing the same junk. I suspect that at some point something got converted to plain text due to some setting somewhere in Tim's "Unknown" newsreader. Hi Garry, Interesting to me that you are seeing that also. I'd been thinking it was something flakey limited to my setup (and spent some time reviewing all of the settings without seeing anything that made a difference :-( -- Ron |
#26
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
Ron Rosenfeld has brought this to us :
On Wed, 13 Feb 2013 17:04:21 -0500, GS wrote: (BTW, for some reason this response of yours has a bunch of formatting codes like … I think they are HTML codes and don't know why this newsreader doesn't handle them). I'm seeing the same junk. I suspect that at some point something got converted to plain text due to some setting somewhere in Tim's "Unknown" newsreader. Hi Garry, Interesting to me that you are seeing that also. I'd been thinking it was something flakey limited to my setup (and spent some time reviewing all of the settings without seeing anything that made a difference :-( -- Ron Yeah, I suspected you might look into it at your end just, if nothing else, to eliminate your reader as the problem. It was my intent to confirm it wasn't unique to you so you wouldn't 'spend' the time trying to find out.<g -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#27
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Thu, 14 Feb 2013 00:01:55 -0500, GS wrote:
Yeah, I suspected you might look into it at your end just, if nothing else, to eliminate your reader as the problem. It was my intent to confirm it wasn't unique to you so you wouldn't 'spend' the time trying to find out.<g Thank you for that. This is not the first time I've seen this sort of thing, and probably won't be the last. So your post will save me quite a bit of time! -- Ron |
#28
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
Ron Rosenfeld brought next idea :
On Thu, 14 Feb 2013 00:01:55 -0500, GS wrote: Yeah, I suspected you might look into it at your end just, if nothing else, to eliminate your reader as the problem. It was my intent to confirm it wasn't unique to you so you wouldn't 'spend' the time trying to find out.<g Thank you for that. This is not the first time I've seen this sort of thing, and probably won't be the last. So your post will save me quite a bit of time! -- Ron I'm sure you know I have Lou Gehrig's and so time/energy are rather precious commodities to me. These can be 'spent' OR 'invested'. I prefer the latter for most things worth doing, though the former is okay for wallowing away "the moments that make up a dull day"!<g -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#29
|
|||
|
|||
BTW the excelbanter.com never did show that garbled character mess you referred to...
Quote:
However I noticed in you latest code that if the NodeAddress is 1 that it keeps the first ten loop as LyyDzzz and then when it hits 2 it changes to NxxxLyyDzzz. Is it possible that if it has more than one node address, that all would use the same format NxxxLyyDzzz. That way it looks consistent Quote:
Question. Is it the intent of the code to add all ten loop when the NodeAddress increases. For example I noticed that if I added a NodeAddress of 2 and a LoopSelection of 1 at the bottom of the PanelData sheet, it adds all ten loop for that NodeAddress of two. In the field the panels could have any amount of loops up to ten. I am just questioning because the summary sheet would need to follow the same layout Last edited by TimLeonard : February 15th 13 at 01:08 AM Reason: . |
#30
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Thu, 14 Feb 2013 11:56:13 -0500, GS wrote:
I'm sure you know I have Lou Gehrig's and so time/energy are rather precious commodities to me. These can be 'spent' OR 'invested'. I prefer the latter for most things worth doing, though the former is okay for wallowing away "the moments that make up a dull day"!<g No, I did not know that you had any illness, much less ALS. I wish you the very best, and hope that you have lots of time to spend, or invest, as you choose. -- Ron |
#31
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
Ron Rosenfeld laid this down on his screen :
On Thu, 14 Feb 2013 11:56:13 -0500, GS wrote: I'm sure you know I have Lou Gehrig's and so time/energy are rather precious commodities to me. These can be 'spent' OR 'invested'. I prefer the latter for most things worth doing, though the former is okay for wallowing away "the moments that make up a dull day"!<g No, I did not know that you had any illness, much less ALS. I wish you the very best, and hope that you have lots of time to spend, or invest, as you choose. -- Ron Ron, Thank you for your kind words. I apologize for making the assumption! (I thought you'd have known through reading my posts over the years) Anyway, I started getting symptoms in Jan'93 and so I'm now just started into my 21st year. Given its nature I've adopted a life motto... "live today like there's no tomorrow" ...and so on we go! -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#32
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Thu, 14 Feb 2013 20:34:23 +0000, TimLeonard wrote:
The format NxxxLyyyDzzz is fine with me Makes things simpler. However I noticed in you latest code that if the NodeAddress is 1 that it keeps the first ten loop as LyyDzzz and then when it hits 2 it changes to NxxxLyyDzzz. Is it possible that if it has more than one node address, that all would use the same format NxxxLyyDzzz. That way it looks consistent Yes it is. I didn't know which way you wanted it. Yes if more then one NodeAddress then NxxxZxxx would work fine. OK Question. Is it the intent of the code to add all ten loop when the NodeAddress increases. For example I noticed that if I added a NodeAddress of 2 and a LoopSelection of 1 at the bottom of the PanelData sheet, it adds all ten loop for that NodeAddress of two. In the field the panels could have any amount of loops up to ten. I am just questioning because the summary sheet would need to follow the same layout The code does that, since, as written, it doesn't differentiate the number of loops from the number of loops per node. It doesn't have to. Should we? Or, if there are multiple nodes, should we only populate the "full list" up to the maximum number of loops per node? An associated question would be: Will all ten loops in node 1 be used before going on to node 2. Or could we have, for example, Node 1 with three loops, Node 2 with five loops, and Node 3 with 1 loop? |
#33
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Thu, 14 Feb 2013 17:59:16 -0500, GS wrote:
Ron, Thank you for your kind words. I apologize for making the assumption! (I thought you'd have known through reading my posts over the years) Anyway, I started getting symptoms in Jan'93 and so I'm now just started into my 21st year. Given its nature I've adopted a life motto... "live today like there's no tomorrow" There's certainly no need to apologize to me. And your motto is one that all should keep in mind at some point in their lives. |
#34
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Thu, 14 Feb 2013 20:34:23 +0000, TimLeonard wrote:
Question. Is it the intent of the code to add all ten loop when the NodeAddress increases. For example I noticed that if I added a NodeAddress of 2 and a LoopSelection of 1 at the bottom of the PanelData sheet, it adds all ten loop for that NodeAddress of two. In the field the panels could have any amount of loops up to ten. I am just questioning because the summary sheet would need to follow the same layout I miswrote. The code only adds loops to each NodeAddress up to the maximum number of loops in the panel in any node. In other words, if the set up is Node 1 -- 2 loops Node 2 -- 3 loops Then the result will show three loops for each node. Is that OK? Or do you want a different algorithm? Here is revised codes with the Merged Address scheme we have discussed Includes Nxxx in the Zone labelling if more than one node address in panel data Includes Nxxx in node address 1 MergedAddress configurations. Let me know if you see any issues. By the way, you will note that occasionally I look directly at the worksheet rather than the VBA array for certain parameters. I am trying to expedite the speed. In general, the fewer worksheet references the better. However, there are some operations that perform more quickly when done on the worksheet -- for example, worksheetfunction.max. Where I am not sure which way is the fastest, I guess based in part on coding complexity. For example, sorting large tables. =========================================== Option Explicit 'column names/labels are defined here. 'they must match exactly the names on PanelData Worksheet 'include names for any added columns ' and also be the same on any sheet generated ' by this code Public Const sNA As String = "NodeAddress" Public Const sLS As String = "LoopSelection" Public Const sDA As String = "DeviceAddress" Public Const sDT As String = "DeviceType" Public Const sDTS As String = "Device Types" Public Const sDL As String = "DeviceLabel" Public Const sEL As String = "ExtendedLabel" Public Const sMA As String = "Merged Address" Sub CreateCompareDataSheet() 'Do this on a CompareData2 Sheet 'Keep only columns C:H 'Remove lines with no valid Device Address; (or not as required) 'Add Merged Address Column 'Append the "missing" Merged Addresses 'Rearrange columns by horizontal sorting according to custom list 'Sort results by Merged Address Dim wsCompareData2 As Worksheet Dim wsPD As Worksheet, vPD As Variant 'Panel Data Dim r As Range, rw As Range, rMissed As Range Dim NAcol As Long 'NodeAddress column Dim NAwscol As Long 'NodeAddress column on worksheet Dim LScol As Long 'Loop Selection column Dim LSwscol As Long 'Loop Selection column on worksheet Dim DTcol As Long 'Device Type column Dim sDTP As String 'Used to create Merged Address Dim DAcol As Long 'Device Address column Dim MAcol As Long 'Merged Address column Dim collUsedMA As Collection 'Used Merged Address Collection Dim collMissMA As Collection 'Missing Merged Addresses Dim DTScol As Long 'Device Types column Dim NumNodes As Long, NumLoops As Long Dim aTemp() As Variant Dim v As Variant Dim i As Long, j As Long Set wsPD = Worksheets("PanelData") 'Clear CompareData2 sheet if present; create if not On Error Resume Next Set wsCompareData2 = Worksheets("CompareData2") If Err.Number = 9 Then Worksheets.Add ActiveSheet.Name = "CompareData2" Set wsCompareData2 = Worksheets("CompareData2") End If On Error GoTo 0 wsCompareData2.Cells.Clear 'Read Panel Data into array 'Assuming zero(0) blanks in Col A 'Assume we will retain only cols A:H With wsPD vPD = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) _ .Offset(columnoffset:=2).Resize(columnsize:=6) End With 'Add column for merged address 'For now, it will be the "last column", but could be moved if desired ReDim Preserve vPD(1 To UBound(vPD, 1), 1 To UBound(vPD, 2) + 2) MAcol = UBound(vPD, 2) - 1 DTScol = UBound(vPD, 2) vPD(1, MAcol) = sMA vPD(1, DTScol) = sDTS 'Get column numbers for data to create Used MergedAddress ReDim aTemp(1 To UBound(vPD, 2)) For i = 1 To UBound(vPD, 2) aTemp(i) = vPD(1, i) Next i With WorksheetFunction NAcol = .Match(sNA, aTemp, 0) LScol = .Match(sLS, aTemp, 0) DTcol = .Match(sDT, aTemp, 0) DAcol = .Match(sDA, aTemp, 0) NAwscol = .Match(sNA, wsPD.Rows(1), 0) LSwscol = .Match(sLS, wsPD.Rows(1), 0) NumLoops = .Max(wsPD.Columns(LSwscol)) NumNodes = .Max(wsPD.Columns(NAwscol)) End With 'Create Merged Addresses 'Add Device Types Field Set collUsedMA = New Collection For i = 2 To UBound(vPD, 1) Select Case vPD(i, DTcol) Case Is = 1 sDTP = "D" vPD(i, DTScol) = "Detector" Case Is = 2 sDTP = "M" vPD(i, DTScol) = "Monitor" Case Is = 3 sDTP = "Z" vPD(i, DTScol) = "Zone" Case Else sDTP = "" End Select If Not sDTP = "" Then vPD(i, MAcol) = _ IIf(NumNodes 1, "N" & Format(vPD(i, NAcol), "000"), "") & _ "L" & Format(vPD(i, LScol), "00") & _ sDTP & _ Format(vPD(i, DAcol), "000") 'Special Case for Z vPD(i, MAcol) = Replace(vPD(i, MAcol), "L00Z", "Z") On Error Resume Next collUsedMA.Add Item:=vPD(i, MAcol), Key:=vPD(i, MAcol) If Err.Number < 0 Then MsgBox ("Merged Address: " & vPD(i, MAcol) & _ "on Line " & i & " is a duplicate") Exit Sub End If On Error GoTo 0 End If Next i 'Develop collection of Missing Merged Addresses Set collMissMA = New Collection v = GenLoops(NumLoops, NumNodes) On Error Resume Next For i = LBound(v) To UBound(v) collUsedMA.Add Item:=v(i), Key:=v(i) If Err.Number = 0 Then collMissMA.Add Item:=v(i), Key:=v(i) End If Err.Clear Next i 'write array to CompareData2 sheet 'sort by Merged Addresses and delete lines with no MA's 'then sort horizontally by first row and custom sort 'set up custom order based on fields in row 1 of panel data 'verify labels are correct 'Column Headers for Compare and Summary Sheets 'Need to be in the desired order -- will be used as a Custom Sort Order List 'Need to match exactly the headers (but not the order) ' on the PanelData worksheet Dim aCL(1 To 8) 'custom list array aCL(1) = sNA aCL(2) = sLS aCL(3) = sDA aCL(4) = sMA aCL(5) = sDT aCL(6) = sDTS aCL(7) = sDL aCL(8) = sEL ReDim aTemp(1 To UBound(vPD, 2)) For i = 1 To UBound(vPD, 2) aTemp(i) = vPD(1, i) Next i On Error Resume Next For i = 1 To UBound(aCL) j = WorksheetFunction.Match(aCL(i), aTemp, 0) If Err.Number < 0 Then MsgBox (aCL(i) & " Not exact match in Panel Data Label row") Exit Sub End If Next i 'Write data to CompareData2 sheet Application.ScreenUpdating = False With wsCompareData2 Set r = .Range("B1").Resize(rowsize:=UBound(vPD, 1), columnsize:=UBound(vPD, 2)) r = vPD 'Add the Missing Merged Addresses to the correct column 'Also deconstruct to fill in the NA, LS, DA and DT columns 'Possible formats ' Znnn ' LnnXnnn ' NnnnLnnXnnn Set rw = r.Rows(1) With WorksheetFunction MAcol = .Match(sMA, rw, 0) LScol = .Match(sLS, rw, 0) DAcol = .Match(sDA, rw, 0) DTcol = .Match(sDT, rw, 0) NAcol = .Match(sNA, rw, 0) End With ReDim aTemp(1 To collMissMA.Count, 1 To r.Columns.Count) For i = 1 To collMissMA.Count aTemp(i, MAcol) = collMissMA(i) aTemp(i, DAcol) = Val(Right(collMissMA(i), 3)) Select Case Left(collMissMA(i), 1) Case Is = "Z" aTemp(i, NAcol) = 1 aTemp(i, LScol) = 0 aTemp(i, DTcol) = 3 Case Is = "L" aTemp(i, NAcol) = 1 aTemp(i, LScol) = Val(Mid(collMissMA(i), 2, 2)) Select Case Mid(collMissMA(i), 4, 1) Case Is = "D" aTemp(i, DTcol) = 1 Case Is = "M" aTemp(i, DTcol) = 2 End Select Case Is = "N" aTemp(i, NAcol) = Val(Mid(collMissMA(i), 2, 3)) Select Case Mid(collMissMA(i), 8, 1) Case Is = "D" aTemp(i, DTcol) = 1 aTemp(i, LScol) = Val(Mid(collMissMA(i), 6, 2)) Case Is = "M" aTemp(i, DTcol) = 2 aTemp(i, LScol) = Val(Mid(collMissMA(i), 6, 2)) Case Else 'must be Z aTemp(DTcol) = 3 aTemp(i, LScol) = 0 End Select End Select Next i Set rMissed = .Cells(r.Row + r.Rows.Count, r.Column).Resize(rowsize:=UBound(aTemp, 1), columnsize:=UBound(aTemp, 2)) rMissed = aTemp Set r = Union(r, rMissed) 'Sort by Merged Address and delete those with blank MA's 'if result of sort needs to have Zones last then will need to add a dummy column for sorting .Sort.SortFields.Clear .Sort.SortFields.Add Key:=r.Resize(rowsize:=r.Rows.Count - 1).Offset(rowoffset:=1).Columns(MAcol), _ SortOn:=xlSortOnValues, Order:=xlAscending With .Sort .SetRange r .Header = xlYes .Orientation = xlTopToBottom .Apply End With Set r = Range(r(1, MAcol).End(xlDown).Offset(rowoffset:=1), r(.Cells.Rows.Count, MAcol)) r.EntireRow.Delete 'Now sort horizontally to reorder the columns Set r = .UsedRange .Sort.SortFields.Clear .Sort.SortFields.Add Key:=r.Rows(1), _ SortOn:=xlSortOnValues, Order:=xlAscending, _ CustomOrder:=Join(aCL, ",") With .Sort .SetRange r .Header = xlYes .Orientation = xlLeftToRight .Apply End With r.EntireColumn.AutoFit 'NOTE: Cannot use RGB on Macintosh. If that is a problem, use something 'like colorindex 15 r.Rows(1).Interior.Color = RGB(191, 191, 191) 'Same gray as on your Summary Sheet 'I don't like to activate or select, but I don't know how else to ' freeze panes .Activate With ActiveWindow .SplitRow = 1 .FreezePanes = True End With .Range("a1").Select End With Application.ScreenUpdating = True End Sub '------------------------------------------------------- Function GenLoops(NumLoops As Long, NumNodes As Long) As Variant 'Part 0: N001-N104 (optional) 'Part 1: L01-L10 'Part 2: D or M 'Part 3: 001-159 Dim MergAddr() As String Dim i As Long, j As Long, k As Long, l As Long, m As Long ReDim MergAddr(1 To NumNodes * NumLoops * 2 * 159 + NumNodes * 1000) '+1000 for the zones For i = 1 To NumNodes For j = 1 To NumLoops For k = 1 To 2 For l = 1 To 159 m = m + 1 MergAddr(m) = _ IIf(NumNodes 1, "N" & Format(i, "000"), "") & _ "L" & Format(j, "00") & _ IIf(k = 1, "D", "M") & _ Format(l, "000") Next l Next k Next j Next i 'add in the Zones Merged Addresses j = NumNodes * NumLoops * 2 * 159 For k = 1 To NumNodes For i = 1 To 1000 MergAddr(j + i + (1000 * (k - 1))) = _ IIf(NumNodes 1, "N" & Format(k, "000"), "") & _ "Z" & Format(i - 1, "000") Next i Next k GenLoops = MergAddr End Function =========================================== |
#35
|
|||
|
|||
Quote:
Quote:
Last edited by TimLeonard : February 15th 13 at 07:45 PM Reason: . |
#36
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Fri, 15 Feb 2013 19:39:54 +0000, TimLeonard wrote:
If possible it would be best to only create the actual qty of loops for each panel (NodeAddress) due to file size and run time of the macro as well as the yet to be determined compare function That can be done. Of course, doing it that way will ADD to the run time of this macro, but probably not by a lot; and it's stll taking well under 0.5 sec to excecute on my machine. |
#37
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Fri, 15 Feb 2013 17:55:13 -0500, Ron Rosenfeld wrote:
On Fri, 15 Feb 2013 19:39:54 +0000, TimLeonard wrote: If possible it would be best to only create the actual qty of loops for each panel (NodeAddress) due to file size and run time of the macro as well as the yet to be determined compare function That can be done. Of course, doing it that way will ADD to the run time of this macro, but probably not by a lot; and it's stll taking well under 0.5 sec to excecute on my machine. OK, I have now rewritten so as to limit the number of loops to be the number of loops per node. Question: As written, all the Zones will sort together, at the end of the data table. An alternate sorting scheme would be to have the Zones stay with the Nodes. How would you like it? And should the Z's be listed before or after the M's and D's? |
#38
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Sat, 16 Feb 2013 15:24:53 -0500, Ron Rosenfeld wrote:
As written, all the Zones will sort together, at the end of the data table. That's not correct. They sort at the end of each node address segment. The alternate would be to have them all together. |
#39
Posted to microsoft.public.excel.programming
|
|||
|
|||
leading zeros using ActiveCell.Offset().value to insert row and value
On Fri, 15 Feb 2013 19:39:54 +0000, TimLeonard wrote:
If possible it would be best to only create the actual qty of loops for each panel (NodeAddress) due to file size and run time of the macro as well as the yet to be determined compare function OK, here is code that I am happy with that creates the CompareData sheet with the above constraint. Let me know if you encounter any problems, or see any issues. I will start to look at your request about incorporating information from the DeviceType worksheet subsequently. ================================================= Option Explicit 'column names/labels are defined here. 'they must match exactly the names on PanelData Worksheet 'include names for any added columns ' and also be the same on any sheet generated ' by this code Public Const sNA As String = "NodeAddress" Public Const sLS As String = "LoopSelection" Public Const sDA As String = "DeviceAddress" Public Const sDT As String = "DeviceType" Public Const sDTS As String = "Device Types" Public Const sDL As String = "DeviceLabel" Public Const sEL As String = "ExtendedLabel" Public Const sMA As String = "Merged Address" Sub CreateCompareDataSheet() 'Do this on a CompareData2 Sheet 'Keep only columns C:H 'Remove lines with no valid Device Address; (or not as required) 'Add Merged Address Column 'Append the "missing" Merged Addresses 'Rearrange columns by horizontal sorting according to custom list 'Sort results by Merged Address Dim wsCompareData2 As Worksheet Dim wsPD As Worksheet, vPD As Variant 'Panel Data Dim r As Range, rw As Range, rMissed As Range Dim NAcol As Long 'NodeAddress column Dim NAwscol As Long 'NodeAddress column on worksheet Dim LScol As Long 'Loop Selection column Dim LSwscol As Long 'Loop Selection column on worksheet Dim DTcol As Long 'Device Type column Dim sDTP As String 'Used to create Merged Address Dim DAcol As Long 'Device Address column Dim MAcol As Long 'Merged Address column Dim collUsedMA As Collection 'Used Merged Address Collection Dim collMissMA As Collection 'Missing Merged Addresses Dim DTScol As Long 'Device Types column Dim NumNodes As Long, NumLoops As Long Dim NodeLoops() As Long Dim aTemp() As Variant Dim v As Variant Dim i As Long, j As Long Set wsPD = Worksheets("PanelData") 'Clear CompareData2 sheet if present; create if not On Error Resume Next Set wsCompareData2 = Worksheets("CompareData2") If Err.Number = 9 Then Worksheets.Add ActiveSheet.Name = "CompareData2" Set wsCompareData2 = Worksheets("CompareData2") End If On Error GoTo 0 wsCompareData2.Cells.Clear 'Read Panel Data into array 'Assuming zero(0) blanks in Col A 'Assume we will retain only cols A:H With wsPD vPD = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) _ .Offset(columnoffset:=2).Resize(columnsize:=6) End With 'Add column for merged address 'For now, it will be the "last column", but could be moved if desired ReDim Preserve vPD(1 To UBound(vPD, 1), 1 To UBound(vPD, 2) + 2) MAcol = UBound(vPD, 2) - 1 DTScol = UBound(vPD, 2) vPD(1, MAcol) = sMA vPD(1, DTScol) = sDTS 'Get column numbers for data to create Used MergedAddress ReDim aTemp(1 To UBound(vPD, 2)) For i = 1 To UBound(vPD, 2) aTemp(i) = vPD(1, i) Next i With WorksheetFunction NAcol = .Match(sNA, aTemp, 0) LScol = .Match(sLS, aTemp, 0) DTcol = .Match(sDT, aTemp, 0) DAcol = .Match(sDA, aTemp, 0) NAwscol = .Match(sNA, wsPD.Rows(1), 0) LSwscol = .Match(sLS, wsPD.Rows(1), 0) NumLoops = .Max(wsPD.Columns(LSwscol)) NumNodes = .Max(wsPD.Columns(NAwscol)) End With 'Create Merged Addresses 'Add Device Types Field Set collUsedMA = New Collection For i = 2 To UBound(vPD, 1) Select Case vPD(i, DTcol) Case Is = 1 sDTP = "D" vPD(i, DTScol) = "Detector" Case Is = 2 sDTP = "M" vPD(i, DTScol) = "Monitor" Case Is = 3 sDTP = "Z" vPD(i, DTScol) = "Zone" Case Else sDTP = "" End Select If Not sDTP = "" Then vPD(i, MAcol) = _ IIf(NumNodes 1, "N" & Format(vPD(i, NAcol), "000"), "") & _ "L" & Format(vPD(i, LScol), "00") & _ sDTP & _ Format(vPD(i, DAcol), "000") 'Special Case for Z vPD(i, MAcol) = Replace(vPD(i, MAcol), "L00Z", "Z") On Error Resume Next collUsedMA.Add Item:=vPD(i, MAcol), Key:=vPD(i, MAcol) If Err.Number < 0 Then MsgBox ("Merged Address: " & vPD(i, MAcol) & _ "on Line " & i & " is a duplicate") Exit Sub End If On Error GoTo 0 End If Next i 'Develop collection of Missing Merged Addresses Set collMissMA = New Collection 'Argument for GenLoops will be 2D array 'Dimension1 - Node 'Dimenstion2 - Loops in corresponding Node ReDim NodeLoops(1 To NumNodes) With wsPD .AutoFilterMode = False With Range(.Cells(1, 1), .Cells(.Rows.Count, LSwscol).End(xlUp)) For i = 1 To NumNodes .AutoFilter Field:=NAwscol, Criteria1:=i NodeLoops(i) = WorksheetFunction.Subtotal(4, .Columns(LSwscol)) Next i End With .AutoFilterMode = False End With v = GenLoops(NodeLoops) On Error Resume Next For i = LBound(v) To UBound(v) collUsedMA.Add Item:=v(i), Key:=v(i) If Err.Number = 0 Then collMissMA.Add Item:=v(i), Key:=v(i) End If Err.Clear Next i 'write array to CompareData2 sheet 'sort by Merged Addresses and delete lines with no MA's 'then sort horizontally by first row and custom sort 'set up custom order based on fields in row 1 of panel data 'verify labels are correct 'Column Headers for Compare and Summary Sheets 'Need to be in the desired order -- will be used as a Custom Sort Order List 'Need to match exactly the headers (but not the order) ' on the PanelData worksheet Dim aCL(1 To 8) 'custom list array aCL(1) = sNA aCL(2) = sLS aCL(3) = sDA aCL(4) = sMA aCL(5) = sDT aCL(6) = sDTS aCL(7) = sDL aCL(8) = sEL ReDim aTemp(1 To UBound(vPD, 2)) For i = 1 To UBound(vPD, 2) aTemp(i) = vPD(1, i) Next i On Error Resume Next For i = 1 To UBound(aCL) j = WorksheetFunction.Match(aCL(i), aTemp, 0) If Err.Number < 0 Then MsgBox (aCL(i) & " Not exact match in Panel Data Label row") Exit Sub End If Next i 'Write data to CompareData2 sheet Application.ScreenUpdating = False With wsCompareData2 Set r = .Range("B1").Resize(rowsize:=UBound(vPD, 1), columnsize:=UBound(vPD, 2)) r = vPD 'Add the Missing Merged Addresses to the correct column 'Also deconstruct to fill in the NA, LS, DA and DT columns 'Possible formats ' Znnn ' LnnXnnn ' NnnnLnnXnnn Set rw = r.Rows(1) With WorksheetFunction MAcol = .Match(sMA, rw, 0) LScol = .Match(sLS, rw, 0) DAcol = .Match(sDA, rw, 0) DTcol = .Match(sDT, rw, 0) NAcol = .Match(sNA, rw, 0) End With ReDim aTemp(1 To collMissMA.Count, 1 To r.Columns.Count) For i = 1 To collMissMA.Count aTemp(i, MAcol) = collMissMA(i) aTemp(i, DAcol) = Val(Right(collMissMA(i), 3)) Select Case Left(collMissMA(i), 1) Case Is = "Z" aTemp(i, NAcol) = 1 aTemp(i, LScol) = 0 aTemp(i, DTcol) = 3 Case Is = "L" aTemp(i, NAcol) = 1 aTemp(i, LScol) = Val(Mid(collMissMA(i), 2, 2)) Select Case Mid(collMissMA(i), 4, 1) Case Is = "D" aTemp(i, DTcol) = 1 Case Is = "M" aTemp(i, DTcol) = 2 End Select Case Is = "N" aTemp(i, NAcol) = Val(Mid(collMissMA(i), 2, 3)) Select Case Mid(collMissMA(i), 8, 1) Case Is = "D" aTemp(i, DTcol) = 1 aTemp(i, LScol) = Val(Mid(collMissMA(i), 6, 2)) Case Is = "M" aTemp(i, DTcol) = 2 aTemp(i, LScol) = Val(Mid(collMissMA(i), 6, 2)) Case Else 'must be Z aTemp(i, DTcol) = 3 aTemp(i, LScol) = 0 End Select End Select Next i Set rMissed = .Cells(r.Row + r.Rows.Count, r.Column).Resize(rowsize:=UBound(aTemp, 1), columnsize:=UBound(aTemp, 2)) rMissed = aTemp Set r = Union(r, rMissed) 'Sort by Merged Address and delete those with blank MA's 'if result of sort needs to have Zones last then will need to add a dummy column for sorting .Sort.SortFields.Clear .Sort.SortFields.Add Key:=r.Resize(rowsize:=r.Rows.Count - 1).Offset(rowoffset:=1).Columns(MAcol), _ SortOn:=xlSortOnValues, Order:=xlAscending With .Sort .SetRange r .Header = xlYes .Orientation = xlTopToBottom .Apply End With Set r = Range(r(1, MAcol).End(xlDown).Offset(rowoffset:=1), r(.Cells.Rows.Count, MAcol)) r.EntireRow.Delete 'Now sort horizontally to reorder the columns Set r = .UsedRange .Sort.SortFields.Clear .Sort.SortFields.Add Key:=r.Rows(1), _ SortOn:=xlSortOnValues, Order:=xlAscending, _ CustomOrder:=Join(aCL, ",") With .Sort .SetRange r .Header = xlYes .Orientation = xlLeftToRight .Apply End With r.EntireColumn.AutoFit 'NOTE: Cannot use RGB on Macintosh. If that is a problem, use something 'like colorindex 15 r.Rows(1).Interior.Color = RGB(191, 191, 191) 'Same gray as on your Summary Sheet 'I don't like to activate or select, but I don't know how else to ' freeze panes .Activate With ActiveWindow .SplitRow = 1 .FreezePanes = True End With .Range("a1").Select End With Application.ScreenUpdating = True End Sub '------------------------------------------------------- Function GenLoops(NL) As Variant 'Part 0: N001-N104 (if more than one node) 'Part 1: L01-L10 (omit if part 2 is Z) 'Part 2: D or M or Z 'Part 3: 001-159 if part 2 is D|M; 0-999 if part 2 is Z Dim MergAddr() As String Dim NumLoops As Long, NumNodes As Long Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long For i = 1 To UBound(NL) j = j + NL(i) * 2 * 159 + 1000 Next i ReDim MergAddr(1 To j) '+1000 for the zones NumNodes = UBound(NL, 1) For i = 1 To NumNodes NumLoops = NL(i) For j = 1 To NumLoops For k = 1 To 2 For l = 1 To 159 m = m + 1 MergAddr(m) = _ IIf(NumNodes 1, "N" & Format(i, "000"), "") & _ "L" & Format(j, "00") & _ IIf(k = 1, "D", "M") & _ Format(l, "000") Next l Next k Next j Next i 'add in the Zones Merged Addresses j = UBound(MergAddr) - 1000 * UBound(NL) For k = 1 To NumNodes For i = 1 To 1000 MergAddr(j + i + (1000 * (k - 1))) = _ IIf(NumNodes 1, "N" & Format(k, "000"), "") & _ "Z" & Format(i - 1, "000") Next i Next k GenLoops = MergAddr End Function ============================================ |
#40
|
|||
|
|||
Quote:
Quote:
|
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Replace leading zeros with leading spaces ? | Excel Programming | |||
If activecell.column = variable then activecell,offset (0,1) | Excel Discussion (Misc queries) | |||
How do I insert leading zeros? | New Users to Excel | |||
save text field w/ leading zeros in .csv format & not lose zeros? | Excel Discussion (Misc queries) | |||
Insert Leading Zeros | Excel Worksheet Functions |